# 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}