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# 16set 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# 77set 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# 127set 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# 151proc 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# 163foreach 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# 175proc 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. 217proc inop {lhs args} { 218 foreach a $args { 219 if {$a==$lhs} {return 1} 220 } 221 return 0 222} 223proc betweenop {lhs first second} { 224 return [expr {$lhs>=$first && $lhs<=$second}] 225} 226proc coalesce_subquery {a b e} { 227 if {$b} { 228 return $a 229 } else { 230 return $e 231 } 232} 233proc one {args} { 234 return 1 235} 236 237# Begin generating the test script: 238# 239puts {# 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 $ 260set testdir [file dirname $argv0] 261source $testdir/tester.tcl 262 263# Create test data 264# 265do_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# 276set a [expr {wide(100)}] 277set b [expr {wide(200)}] 278set c [expr {wide(300)}] 279set d [expr {wide(400)}] 280set e [expr {wide(500)}] 281set f [expr {wide(600)}] 282 283# A procedure to generate a test case. 284# 285set tn 0 286proc 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# 294expr srand(0) 295for {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# 342puts {finish_test} 343