summaryrefslogtreecommitdiffstats
path: root/test/randexpr1.tcl
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--test/randexpr1.tcl342
1 files changed, 342 insertions, 0 deletions
diff --git a/test/randexpr1.tcl b/test/randexpr1.tcl
new file mode 100644
index 0000000..37ebf53
--- /dev/null
+++ b/test/randexpr1.tcl
@@ -0,0 +1,342 @@
+# Run this TCL script to generate thousands of test cases containing
+# complicated expressions.
+#
+# The generated tests are intended to verify expression evaluation
+# in SQLite against expression evaluation TCL.
+#
+
+# Terms of the $intexpr list each contain two sub-terms.
+#
+# * An SQL expression template
+# * The equivalent TCL expression
+#
+# EXPR is replaced by an integer subexpression. BOOL is replaced
+# by a boolean subexpression.
+#
+set intexpr {
+ {11 wide(11)}
+ {13 wide(13)}
+ {17 wide(17)}
+ {19 wide(19)}
+ {a $a}
+ {b $b}
+ {c $c}
+ {d $d}
+ {e $e}
+ {f $f}
+ {t1.a $a}
+ {t1.b $b}
+ {t1.c $c}
+ {t1.d $d}
+ {t1.e $e}
+ {t1.f $f}
+ {(EXPR) (EXPR)}
+ {{ -EXPR} {-EXPR}}
+ {+EXPR +EXPR}
+ {~EXPR ~EXPR}
+ {EXPR+EXPR EXPR+EXPR}
+ {EXPR-EXPR EXPR-EXPR}
+ {EXPR*EXPR EXPR*EXPR}
+ {EXPR+EXPR EXPR+EXPR}
+ {EXPR-EXPR EXPR-EXPR}
+ {EXPR*EXPR EXPR*EXPR}
+ {EXPR+EXPR EXPR+EXPR}
+ {EXPR-EXPR EXPR-EXPR}
+ {EXPR*EXPR EXPR*EXPR}
+ {{EXPR | EXPR} {EXPR | EXPR}}
+ {(abs(EXPR)/abs(EXPR)) (abs(EXPR)/abs(EXPR))}
+ {
+ {case when BOOL then EXPR else EXPR end}
+ {((BOOL)?EXPR:EXPR)}
+ }
+ {
+ {case when BOOL then EXPR when BOOL then EXPR else EXPR end}
+ {((BOOL)?EXPR:((BOOL)?EXPR:EXPR))}
+ }
+ {
+ {case EXPR when EXPR then EXPR else EXPR end}
+ {(((EXPR)==(EXPR))?EXPR:EXPR)}
+ }
+ {
+ {(select AGG from t1)}
+ {(AGG)}
+ }
+ {
+ {coalesce((select max(EXPR) from t1 where BOOL),EXPR)}
+ {[coalesce_subquery [expr {EXPR}] [expr {BOOL}] [expr {EXPR}]]}
+ }
+ {
+ {coalesce((select EXPR from t1 where BOOL),EXPR)}
+ {[coalesce_subquery [expr {EXPR}] [expr {BOOL}] [expr {EXPR}]]}
+ }
+}
+
+# The $boolexpr list contains terms that show both an SQL boolean
+# expression and its equivalent TCL.
+#
+set boolexpr {
+ {EXPR=EXPR ((EXPR)==(EXPR))}
+ {EXPR<EXPR ((EXPR)<(EXPR))}
+ {EXPR>EXPR ((EXPR)>(EXPR))}
+ {EXPR<=EXPR ((EXPR)<=(EXPR))}
+ {EXPR>=EXPR ((EXPR)>=(EXPR))}
+ {EXPR<>EXPR ((EXPR)!=(EXPR))}
+ {
+ {EXPR between EXPR and EXPR}
+ {[betweenop [expr {EXPR}] [expr {EXPR}] [expr {EXPR}]]}
+ }
+ {
+ {EXPR not between EXPR and EXPR}
+ {(![betweenop [expr {EXPR}] [expr {EXPR}] [expr {EXPR}]])}
+ }
+ {
+ {EXPR in (EXPR,EXPR,EXPR)}
+ {([inop [expr {EXPR}] [expr {EXPR}] [expr {EXPR}] [expr {EXPR}]])}
+ }
+ {
+ {EXPR not in (EXPR,EXPR,EXPR)}
+ {(![inop [expr {EXPR}] [expr {EXPR}] [expr {EXPR}] [expr {EXPR}]])}
+ }
+ {
+ {EXPR in (select EXPR from t1 union select EXPR from t1)}
+ {[inop [expr {EXPR}] [expr {EXPR}] [expr {EXPR}]]}
+ }
+ {
+ {EXPR in (select AGG from t1 union select AGG from t1)}
+ {[inop [expr {EXPR}] [expr {AGG}] [expr {AGG}]]}
+ }
+ {
+ {exists(select 1 from t1 where BOOL)}
+ {(BOOL)}
+ }
+ {
+ {not exists(select 1 from t1 where BOOL)}
+ {!(BOOL)}
+ }
+ {{not BOOL} !BOOL}
+ {{BOOL and BOOL} {BOOL tcland BOOL}}
+ {{BOOL or BOOL} {BOOL || BOOL}}
+ {{BOOL and BOOL} {BOOL tcland BOOL}}
+ {{BOOL or BOOL} {BOOL || BOOL}}
+ {(BOOL) (BOOL)}
+ {(BOOL) (BOOL)}
+}
+
+# Aggregate expressions
+#
+set aggexpr {
+ {count(*) wide(1)}
+ {{count(distinct EXPR)} {[one {EXPR}]}}
+ {{cast(avg(EXPR) AS integer)} (EXPR)}
+ {min(EXPR) (EXPR)}
+ {max(EXPR) (EXPR)}
+ {(AGG) (AGG)}
+ {{ -AGG} {-AGG}}
+ {+AGG +AGG}
+ {~AGG ~AGG}
+ {abs(AGG) abs(AGG)}
+ {AGG+AGG AGG+AGG}
+ {AGG-AGG AGG-AGG}
+ {AGG*AGG AGG*AGG}
+ {{AGG | AGG} {AGG | AGG}}
+ {
+ {case AGG when AGG then AGG else AGG end}
+ {(((AGG)==(AGG))?AGG:AGG)}
+ }
+}
+
+# Convert a string containing EXPR, AGG, and BOOL into a string
+# that contains nothing but X, Y, and Z.
+#
+proc extract_vars {a} {
+ regsub -all {EXPR} $a X a
+ regsub -all {AGG} $a Y a
+ regsub -all {BOOL} $a Z a
+ regsub -all {[^XYZ]} $a {} a
+ return $a
+}
+
+
+# Test all templates to make sure the number of EXPR, AGG, and BOOL
+# expressions match.
+#
+foreach term [concat $aggexpr $intexpr $boolexpr] {
+ foreach {a b} $term break
+ if {[extract_vars $a]!=[extract_vars $b]} {
+ error "mismatch: $term"
+ }
+}
+
+# Generate a random expression according to the templates given above.
+# If the argument is EXPR or omitted, then an integer expression is
+# generated. If the argument is BOOL then a boolean expression is
+# produced.
+#
+proc generate_expr {{e EXPR}} {
+ set tcle $e
+ set ne [llength $::intexpr]
+ set nb [llength $::boolexpr]
+ set na [llength $::aggexpr]
+ set div 2
+ set mx 50
+ set i 0
+ while {1} {
+ set cnt 0
+ set re [lindex $::intexpr [expr {int(rand()*$ne)}]]
+ incr cnt [regsub {EXPR} $e [lindex $re 0] e]
+ regsub {EXPR} $tcle [lindex $re 1] tcle
+ set rb [lindex $::boolexpr [expr {int(rand()*$nb)}]]
+ incr cnt [regsub {BOOL} $e [lindex $rb 0] e]
+ regsub {BOOL} $tcle [lindex $rb 1] tcle
+ set ra [lindex $::aggexpr [expr {int(rand()*$na)}]]
+ incr cnt [regsub {AGG} $e [lindex $ra 0] e]
+ regsub {AGG} $tcle [lindex $ra 1] tcle
+
+ if {$cnt==0} break
+ incr i $cnt
+
+ set v1 [extract_vars $e]
+ if {$v1!=[extract_vars $tcle]} {
+ exit
+ }
+
+ if {$i+[string length $v1]>=$mx} {
+ set ne [expr {$ne/$div}]
+ set nb [expr {$nb/$div}]
+ set na [expr {$na/$div}]
+ set div 1
+ set mx [expr {$mx*1000}]
+ }
+ }
+ regsub -all { tcland } $tcle { \&\& } tcle
+ return [list $e $tcle]
+}
+
+# Implementation of routines used to implement the IN and BETWEEN
+# operators.
+proc inop {lhs args} {
+ foreach a $args {
+ if {$a==$lhs} {return 1}
+ }
+ return 0
+}
+proc betweenop {lhs first second} {
+ return [expr {$lhs>=$first && $lhs<=$second}]
+}
+proc coalesce_subquery {a b e} {
+ if {$b} {
+ return $a
+ } else {
+ return $e
+ }
+}
+proc one {args} {
+ return 1
+}
+
+# Begin generating the test script:
+#
+puts {# 2008 December 16
+#
+# The author disclaims copyright to this source code. In place of
+# a legal notice, here is a blessing:
+#
+# May you do good and not evil.
+# May you find forgiveness for yourself and forgive others.
+# May you share freely, never taking more than you give.
+#
+#***********************************************************************
+# This file implements regression tests for SQLite library.
+#
+# This file tests randomly generated SQL expressions. The expressions
+# are generated by a TCL script. The same TCL script also computes the
+# correct value of the expression. So, from one point of view, this
+# file verifies the expression evaluation logic of SQLite against the
+# expression evaluation logic of TCL.
+#
+# An early version of this script is how bug #3541 was detected.
+#
+# $Id: randexpr1.tcl,v 1.1 2008/12/15 16:33:30 drh Exp $
+set testdir [file dirname $argv0]
+source $testdir/tester.tcl
+
+# Create test data
+#
+do_test randexpr1-1.1 {
+ db eval {
+ CREATE TABLE t1(a,b,c,d,e,f);
+ INSERT INTO t1 VALUES(100,200,300,400,500,600);
+ SELECT * FROM t1
+ }
+} {100 200 300 400 500 600}
+}
+
+# Test data for TCL evaluation.
+#
+set a [expr {wide(100)}]
+set b [expr {wide(200)}]
+set c [expr {wide(300)}]
+set d [expr {wide(400)}]
+set e [expr {wide(500)}]
+set f [expr {wide(600)}]
+
+# A procedure to generate a test case.
+#
+set tn 0
+proc make_test_case {sql result} {
+ global tn
+ incr tn
+ puts "do_test randexpr-2.$tn {\n db eval {$sql}\n} {$result}"
+}
+
+# Generate many random test cases.
+#
+expr srand(0)
+for {set i 0} {$i<1000} {incr i} {
+ while {1} {
+ foreach {sqle tcle} [generate_expr EXPR] break;
+ if {[catch {expr $tcle} ans]} {
+ #puts stderr [list $tcle]
+ #puts stderr ans=$ans
+ if {![regexp {divide by zero} $ans]} exit
+ continue
+ }
+ set len [string length $sqle]
+ if {$len<100 || $len>2000} continue
+ if {[info exists seen($sqle)]} continue
+ set seen($sqle) 1
+ break
+ }
+ while {1} {
+ foreach {sqlb tclb} [generate_expr BOOL] break;
+ if {[catch {expr $tclb} bans]} {
+ #puts stderr [list $tclb]
+ #puts stderr bans=$bans
+ if {![regexp {divide by zero} $bans]} exit
+ continue
+ }
+ break
+ }
+ if {$bans} {
+ make_test_case "SELECT $sqle FROM t1 WHERE $sqlb" $ans
+ make_test_case "SELECT $sqle FROM t1 WHERE NOT ($sqlb)" {}
+ } else {
+ make_test_case "SELECT $sqle FROM t1 WHERE $sqlb" {}
+ make_test_case "SELECT $sqle FROM t1 WHERE NOT ($sqlb)" $ans
+ }
+ if {[regexp { \| } $sqle]} {
+ regsub -all { \| } $sqle { \& } sqle
+ regsub -all { \| } $tcle { \& } tcle
+ if {[catch {expr $tcle} ans]==0} {
+ if {$bans} {
+ make_test_case "SELECT $sqle FROM t1 WHERE $sqlb" $ans
+ } else {
+ make_test_case "SELECT $sqle FROM t1 WHERE NOT ($sqlb)" $ans
+ }
+ }
+ }
+}
+
+# Terminate the test script
+#
+puts {finish_test}
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-19 00:38:12 +0000