wasCSharpSQLite – Blame information for rev 1

Subversion Repositories:
Rev:
Rev Author Line No. Line
1 office 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}