Annotation of embedaddon/sqlite3/test/randexpr1.tcl, revision 1.1
1.1 ! misho 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: #
! 16: set 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: #
! 77: set 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: #
! 127: set 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: #
! 151: proc 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: #
! 163: foreach 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: #
! 175: proc 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.
! 217: proc inop {lhs args} {
! 218: foreach a $args {
! 219: if {$a==$lhs} {return 1}
! 220: }
! 221: return 0
! 222: }
! 223: proc betweenop {lhs first second} {
! 224: return [expr {$lhs>=$first && $lhs<=$second}]
! 225: }
! 226: proc coalesce_subquery {a b e} {
! 227: if {$b} {
! 228: return $a
! 229: } else {
! 230: return $e
! 231: }
! 232: }
! 233: proc one {args} {
! 234: return 1
! 235: }
! 236:
! 237: # Begin generating the test script:
! 238: #
! 239: puts {# 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 $
! 260: set testdir [file dirname $argv0]
! 261: source $testdir/tester.tcl
! 262:
! 263: # Create test data
! 264: #
! 265: do_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: #
! 276: set a [expr {wide(100)}]
! 277: set b [expr {wide(200)}]
! 278: set c [expr {wide(300)}]
! 279: set d [expr {wide(400)}]
! 280: set e [expr {wide(500)}]
! 281: set f [expr {wide(600)}]
! 282:
! 283: # A procedure to generate a test case.
! 284: #
! 285: set tn 0
! 286: proc 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: #
! 294: expr srand(0)
! 295: for {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: #
! 342: puts {finish_test}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to randexpr1.tcl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / sqlite3 / test