github.com/jdgcs/sqlite3@v1.12.1-0.20210908114423-bc5f96e4dd51/testdata/tcl/randexpr1.tcl (about)

     1  # Run this TCL script to generate thousands of test cases containing
     2  # complicated expressions.
     3  #
     4  # The generated tests are intended to verify expression evaluation
     5  # in SQLite against expression evaluation TCL.  
     6  #
     7  
     8  # Terms of the $intexpr list each contain two sub-terms.
     9  #
    10  #     *  An SQL expression template
    11  #     *  The equivalent TCL expression
    12  #
    13  # EXPR is replaced by an integer subexpression.  BOOL is replaced
    14  # by a boolean subexpression.
    15  #
    16  set intexpr {
    17    {11 wide(11)}
    18    {13 wide(13)}
    19    {17 wide(17)}
    20    {19 wide(19)}
    21    {a $a}
    22    {b $b}
    23    {c $c}
    24    {d $d}
    25    {e $e}
    26    {f $f}
    27    {t1.a $a}
    28    {t1.b $b}
    29    {t1.c $c}
    30    {t1.d $d}
    31    {t1.e $e}
    32    {t1.f $f}
    33    {(EXPR) (EXPR)}
    34    {{ -EXPR} {-EXPR}}
    35    {+EXPR +EXPR}
    36    {~EXPR ~EXPR}
    37    {EXPR+EXPR EXPR+EXPR}
    38    {EXPR-EXPR EXPR-EXPR}
    39    {EXPR*EXPR EXPR*EXPR}
    40    {EXPR+EXPR EXPR+EXPR}
    41    {EXPR-EXPR EXPR-EXPR}
    42    {EXPR*EXPR EXPR*EXPR}
    43    {EXPR+EXPR EXPR+EXPR}
    44    {EXPR-EXPR EXPR-EXPR}
    45    {EXPR*EXPR EXPR*EXPR}
    46    {{EXPR | EXPR} {EXPR | EXPR}}
    47    {(abs(EXPR)/abs(EXPR)) (abs(EXPR)/abs(EXPR))}
    48    {
    49      {case when BOOL then EXPR else EXPR end}
    50      {((BOOL)?EXPR:EXPR)}
    51    }
    52    {
    53      {case when BOOL then EXPR when BOOL then EXPR else EXPR end}
    54      {((BOOL)?EXPR:((BOOL)?EXPR:EXPR))}
    55    }
    56    {
    57      {case EXPR when EXPR then EXPR else EXPR end}
    58      {(((EXPR)==(EXPR))?EXPR:EXPR)}
    59    }
    60    {
    61      {(select AGG from t1)}
    62      {(AGG)}
    63    }
    64    {
    65      {coalesce((select max(EXPR) from t1 where BOOL),EXPR)}
    66      {[coalesce_subquery [expr {EXPR}] [expr {BOOL}] [expr {EXPR}]]}
    67    }
    68    {
    69      {coalesce((select EXPR from t1 where BOOL),EXPR)}
    70      {[coalesce_subquery [expr {EXPR}] [expr {BOOL}] [expr {EXPR}]]}
    71    }
    72  }
    73  
    74  # The $boolexpr list contains terms that show both an SQL boolean
    75  # expression and its equivalent TCL.
    76  #
    77  set boolexpr {
    78    {EXPR=EXPR   ((EXPR)==(EXPR))}
    79    {EXPR<EXPR   ((EXPR)<(EXPR))}
    80    {EXPR>EXPR   ((EXPR)>(EXPR))}
    81    {EXPR<=EXPR  ((EXPR)<=(EXPR))}
    82    {EXPR>=EXPR  ((EXPR)>=(EXPR))}
    83    {EXPR<>EXPR  ((EXPR)!=(EXPR))}
    84    {
    85      {EXPR between EXPR and EXPR}
    86      {[betweenop [expr {EXPR}] [expr {EXPR}] [expr {EXPR}]]}
    87    }
    88    {
    89      {EXPR not between EXPR and EXPR}
    90      {(![betweenop [expr {EXPR}] [expr {EXPR}] [expr {EXPR}]])}
    91    }
    92    {
    93      {EXPR in (EXPR,EXPR,EXPR)}
    94      {([inop [expr {EXPR}] [expr {EXPR}] [expr {EXPR}] [expr {EXPR}]])}
    95    }
    96    {
    97      {EXPR not in (EXPR,EXPR,EXPR)}
    98      {(![inop [expr {EXPR}] [expr {EXPR}] [expr {EXPR}] [expr {EXPR}]])}
    99    }
   100    {
   101      {EXPR in (select EXPR from t1 union select EXPR from t1)}
   102      {[inop [expr {EXPR}] [expr {EXPR}] [expr {EXPR}]]}
   103    }
   104    {
   105      {EXPR in (select AGG from t1 union select AGG from t1)}
   106      {[inop [expr {EXPR}] [expr {AGG}] [expr {AGG}]]}
   107    }
   108    {
   109      {exists(select 1 from t1 where BOOL)}
   110      {(BOOL)}
   111    }
   112    {
   113      {not exists(select 1 from t1 where BOOL)}
   114      {!(BOOL)}
   115    }
   116    {{not BOOL}  !BOOL}
   117    {{BOOL and BOOL} {BOOL tcland BOOL}}
   118    {{BOOL or BOOL}  {BOOL || BOOL}}
   119    {{BOOL and BOOL} {BOOL tcland BOOL}}
   120    {{BOOL or BOOL}  {BOOL || BOOL}}
   121    {(BOOL) (BOOL)}
   122    {(BOOL) (BOOL)}
   123  }
   124  
   125  # Aggregate expressions
   126  #
   127  set aggexpr {
   128    {count(*) wide(1)}
   129    {{count(distinct EXPR)} {[one {EXPR}]}}
   130    {{cast(avg(EXPR) AS integer)} (EXPR)}
   131    {min(EXPR) (EXPR)}
   132    {max(EXPR) (EXPR)}
   133    {(AGG) (AGG)}
   134    {{ -AGG} {-AGG}}
   135    {+AGG +AGG}
   136    {~AGG ~AGG}
   137    {abs(AGG)  abs(AGG)}
   138    {AGG+AGG   AGG+AGG}
   139    {AGG-AGG   AGG-AGG}
   140    {AGG*AGG   AGG*AGG}
   141    {{AGG | AGG}  {AGG | AGG}}
   142    {
   143      {case AGG when AGG then AGG else AGG end}
   144      {(((AGG)==(AGG))?AGG:AGG)}
   145    }
   146  }
   147  
   148  # Convert a string containing EXPR, AGG, and BOOL into a string
   149  # that contains nothing but X, Y, and Z.
   150  #
   151  proc extract_vars {a} {
   152    regsub -all {EXPR} $a X a
   153    regsub -all {AGG} $a Y a
   154    regsub -all {BOOL} $a Z a
   155    regsub -all {[^XYZ]} $a {} a
   156    return $a
   157  }
   158  
   159  
   160  # Test all templates to make sure the number of EXPR, AGG, and BOOL
   161  # expressions match.
   162  #
   163  foreach term [concat $aggexpr $intexpr $boolexpr] {
   164    foreach {a b} $term break
   165    if {[extract_vars $a]!=[extract_vars $b]} {
   166      error "mismatch: $term"
   167    }
   168  }
   169  
   170  # Generate a random expression according to the templates given above.
   171  # If the argument is EXPR or omitted, then an integer expression is
   172  # generated.  If the argument is BOOL then a boolean expression is
   173  # produced.
   174  #
   175  proc generate_expr {{e EXPR}} {
   176    set tcle $e
   177    set ne [llength $::intexpr]
   178    set nb [llength $::boolexpr]
   179    set na [llength $::aggexpr]
   180    set div 2
   181    set mx 50
   182    set i 0
   183    while {1} {
   184      set cnt 0
   185      set re [lindex $::intexpr [expr {int(rand()*$ne)}]]
   186      incr cnt [regsub {EXPR} $e [lindex $re 0] e]
   187      regsub {EXPR} $tcle [lindex $re 1] tcle
   188      set rb [lindex $::boolexpr [expr {int(rand()*$nb)}]]
   189      incr cnt [regsub {BOOL} $e [lindex $rb 0] e]
   190      regsub {BOOL} $tcle [lindex $rb 1] tcle
   191      set ra [lindex $::aggexpr [expr {int(rand()*$na)}]]
   192      incr cnt [regsub {AGG} $e [lindex $ra 0] e]
   193      regsub {AGG} $tcle [lindex $ra 1] tcle
   194  
   195      if {$cnt==0} break
   196      incr i $cnt
   197  
   198      set v1 [extract_vars $e]
   199      if {$v1!=[extract_vars $tcle]} {
   200        exit
   201      }
   202  
   203      if {$i+[string length $v1]>=$mx} {
   204        set ne [expr {$ne/$div}]
   205        set nb [expr {$nb/$div}]
   206        set na [expr {$na/$div}]
   207        set div 1
   208        set mx [expr {$mx*1000}]
   209      }
   210    }
   211    regsub -all { tcland } $tcle { \&\& } tcle
   212    return [list $e $tcle]
   213  }
   214  
   215  # Implementation of routines used to implement the IN and BETWEEN
   216  # operators.
   217  proc inop {lhs args} {
   218    foreach a $args {
   219      if {$a==$lhs} {return 1}
   220    }
   221    return 0
   222  }
   223  proc betweenop {lhs first second} {
   224    return [expr {$lhs>=$first && $lhs<=$second}]
   225  }
   226  proc coalesce_subquery {a b e} {
   227    if {$b} {
   228      return $a
   229    } else {
   230      return $e
   231    }
   232  }
   233  proc one {args} {
   234    return 1
   235  }
   236  
   237  # Begin generating the test script:
   238  #
   239  puts {# 2008 December 16
   240  #
   241  # The author disclaims copyright to this source code.  In place of
   242  # a legal notice, here is a blessing:
   243  #
   244  #    May you do good and not evil.
   245  #    May you find forgiveness for yourself and forgive others.
   246  #    May you share freely, never taking more than you give.
   247  #
   248  #***********************************************************************
   249  # This file implements regression tests for SQLite library.
   250  #
   251  # This file tests randomly generated SQL expressions.  The expressions
   252  # are generated by a TCL script.  The same TCL script also computes the
   253  # correct value of the expression.  So, from one point of view, this
   254  # file verifies the expression evaluation logic of SQLite against the
   255  # expression evaluation logic of TCL.
   256  #
   257  # An early version of this script is how bug #3541 was detected.
   258  #
   259  # $Id: randexpr1.tcl,v 1.1 2008/12/15 16:33:30 drh Exp $
   260  set testdir [file dirname $argv0]
   261  source $testdir/tester.tcl
   262  
   263  # Create test data
   264  #
   265  do_test randexpr1-1.1 {
   266    db eval {
   267      CREATE TABLE t1(a,b,c,d,e,f);
   268      INSERT INTO t1 VALUES(100,200,300,400,500,600);
   269      SELECT * FROM t1
   270    }
   271  } {100 200 300 400 500 600}
   272  }
   273  
   274  # Test data for TCL evaluation.
   275  #
   276  set a [expr {wide(100)}]
   277  set b [expr {wide(200)}]
   278  set c [expr {wide(300)}]
   279  set d [expr {wide(400)}]
   280  set e [expr {wide(500)}]
   281  set f [expr {wide(600)}]
   282  
   283  # A procedure to generate a test case.
   284  #
   285  set tn 0
   286  proc make_test_case {sql result} {
   287    global tn
   288    incr tn
   289    puts "do_test randexpr-2.$tn {\n  db eval {$sql}\n} {$result}"
   290  }
   291  
   292  # Generate many random test cases.
   293  #
   294  expr srand(0)
   295  for {set i 0} {$i<1000} {incr i} {
   296    while {1} {
   297      foreach {sqle tcle} [generate_expr EXPR] break;
   298      if {[catch {expr $tcle} ans]} {
   299        #puts stderr [list $tcle]
   300        #puts stderr ans=$ans
   301        if {![regexp {divide by zero} $ans]} exit
   302        continue
   303      }
   304      set len [string length $sqle]
   305      if {$len<100 || $len>2000} continue
   306      if {[info exists seen($sqle)]} continue
   307      set seen($sqle) 1
   308      break
   309    }
   310    while {1} {
   311      foreach {sqlb tclb} [generate_expr BOOL] break;
   312      if {[catch {expr $tclb} bans]} {
   313        #puts stderr [list $tclb]
   314        #puts stderr bans=$bans
   315        if {![regexp {divide by zero} $bans]} exit
   316        continue
   317      }
   318      break
   319    }
   320    if {$bans} {
   321      make_test_case "SELECT $sqle FROM t1 WHERE $sqlb" $ans
   322      make_test_case "SELECT $sqle FROM t1 WHERE NOT ($sqlb)" {}
   323    } else {
   324      make_test_case "SELECT $sqle FROM t1 WHERE $sqlb" {}
   325      make_test_case "SELECT $sqle FROM t1 WHERE NOT ($sqlb)" $ans
   326    }
   327    if {[regexp { \| } $sqle]} {
   328      regsub -all { \| } $sqle { \& } sqle
   329      regsub -all { \| } $tcle { \& } tcle
   330      if {[catch {expr $tcle} ans]==0} {
   331        if {$bans} {
   332          make_test_case "SELECT $sqle FROM t1 WHERE $sqlb" $ans
   333        } else {
   334          make_test_case "SELECT $sqle FROM t1 WHERE NOT ($sqlb)" $ans
   335        }
   336      }
   337    }
   338  }
   339  
   340  # Terminate the test script
   341  #
   342  puts {finish_test}