test/randexpr1.tcl

   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}