| OLD | NEW | 
 | (Empty) | 
|    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} |  | 
| OLD | NEW |