| Index: third_party/sqlite/src/test/randexpr1.tcl
|
| diff --git a/third_party/sqlite/src/test/randexpr1.tcl b/third_party/sqlite/src/test/randexpr1.tcl
|
| new file mode 100644
|
| index 0000000000000000000000000000000000000000..37ebf531e8509ebd61fa8498a1ab4f8b0e743977
|
| --- /dev/null
|
| +++ b/third_party/sqlite/src/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}
|
|
|