| 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 |