wasCSharpSQLite – Blame information for rev 7
?pathlinks?
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} |