AryaWu/sqlite

1# Run this TCL script to generate thousands of test cases containing2# complicated expressions.3#4# The generated tests are intended to verify expression evaluation5# in SQLite against expression evaluation TCL.  6#7 8# Terms of the $intexpr list each contain two sub-terms.9#10#     *  An SQL expression template11#     *  The equivalent TCL expression12#13# EXPR is replaced by an integer subexpression.  BOOL is replaced14# 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 boolean75# 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 expressions126#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 string149# that contains nothing but X, Y, and Z.150#151proc extract_vars {a} {152  regsub -all {EXPR} $a X a153  regsub -all {AGG} $a Y a154  regsub -all {BOOL} $a Z a155  regsub -all {[^XYZ]} $a {} a156  return $a157}158 159 160# Test all templates to make sure the number of EXPR, AGG, and BOOL161# expressions match.162#163foreach term [concat $aggexpr $intexpr $boolexpr] {164  foreach {a b} $term break165  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 is172# generated.  If the argument is BOOL then a boolean expression is173# produced.174#175proc generate_expr {{e EXPR}} {176  set tcle $e177  set ne [llength $::intexpr]178  set nb [llength $::boolexpr]179  set na [llength $::aggexpr]180  set div 2181  set mx 50182  set i 0183  while {1} {184    set cnt 0185    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] tcle188    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] tcle191    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] tcle194 195    if {$cnt==0} break196    incr i $cnt197 198    set v1 [extract_vars $e]199    if {$v1!=[extract_vars $tcle]} {200      exit201    }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 1208      set mx [expr {$mx*1000}]209    }210  }211  regsub -all { tcland } $tcle { \&\& } tcle212  return [list $e $tcle]213}214 215# Implementation of routines used to implement the IN and BETWEEN216# operators.217proc inop {lhs args} {218  foreach a $args {219    if {$a==$lhs} {return 1}220  }221  return 0222}223proc betweenop {lhs first second} {224  return [expr {$lhs>=$first && $lhs<=$second}]225}226proc coalesce_subquery {a b e} {227  if {$b} {228    return $a229  } else {230    return $e231  }232}233proc one {args} {234  return 1235}236 237# Begin generating the test script:238#239puts {# 2008 December 16240#241# The author disclaims copyright to this source code.  In place of242# 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 expressions252# are generated by a TCL script.  The same TCL script also computes the253# correct value of the expression.  So, from one point of view, this254# file verifies the expression evaluation logic of SQLite against the255# 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.tcl262 263# Create test data264#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 t1270  }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 0286proc make_test_case {sql result} {287  global tn288  incr tn289  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=$ans301      if {![regexp {divide by zero} $ans]} exit302      continue303    }304    set len [string length $sqle]305    if {$len<100 || $len>2000} continue306    if {[info exists seen($sqle)]} continue307    set seen($sqle) 1308    break309  }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=$bans315      if {![regexp {divide by zero} $bans]} exit316      continue317    }318    break319  }320  if {$bans} {321    make_test_case "SELECT $sqle FROM t1 WHERE $sqlb" $ans322    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)" $ans326  }327  if {[regexp { \| } $sqle]} {328    regsub -all { \| } $sqle { \& } sqle329    regsub -all { \| } $tcle { \& } tcle330    if {[catch {expr $tcle} ans]==0} {331      if {$bans} {332        make_test_case "SELECT $sqle FROM t1 WHERE $sqlb" $ans333      } else {334        make_test_case "SELECT $sqle FROM t1 WHERE NOT ($sqlb)" $ans335      }336    }337  }338}339 340# Terminate the test script341#342puts {finish_test}343