Annotation of embedaddon/sqlite3/test/randexpr1.tcl, revision 1.1.1.1
1.1 misho 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}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to randexpr1.tcl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / sqlite3 / test