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