PageRenderTime 48ms CodeModel.GetById 21ms RepoModel.GetById 0ms app.codeStats 1ms

/trunk/src/sqlite/test/randexpr1.tcl

#
TCL | 342 lines | 257 code | 17 blank | 68 comment | 31 complexity | 0e7b690d37129a109aab5dbbb27b9361 MD5 | raw file
Possible License(s): BSD-3-Clause
  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. # Terms of the $intexpr list each contain two sub-terms.
  8. #
  9. # * An SQL expression template
  10. # * The equivalent TCL expression
  11. #
  12. # EXPR is replaced by an integer subexpression. BOOL is replaced
  13. # by a boolean subexpression.
  14. #
  15. set intexpr {
  16. {11 wide(11)}
  17. {13 wide(13)}
  18. {17 wide(17)}
  19. {19 wide(19)}
  20. {a $a}
  21. {b $b}
  22. {c $c}
  23. {d $d}
  24. {e $e}
  25. {f $f}
  26. {t1.a $a}
  27. {t1.b $b}
  28. {t1.c $c}
  29. {t1.d $d}
  30. {t1.e $e}
  31. {t1.f $f}
  32. {(EXPR) (EXPR)}
  33. {{ -EXPR} {-EXPR}}
  34. {+EXPR +EXPR}
  35. {~EXPR ~EXPR}
  36. {EXPR+EXPR 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. {(abs(EXPR)/abs(EXPR)) (abs(EXPR)/abs(EXPR))}
  47. {
  48. {case when BOOL then EXPR else EXPR end}
  49. {((BOOL)?EXPR:EXPR)}
  50. }
  51. {
  52. {case when BOOL then EXPR when BOOL then EXPR else EXPR end}
  53. {((BOOL)?EXPR:((BOOL)?EXPR:EXPR))}
  54. }
  55. {
  56. {case EXPR when EXPR then EXPR else EXPR end}
  57. {(((EXPR)==(EXPR))?EXPR:EXPR)}
  58. }
  59. {
  60. {(select AGG from t1)}
  61. {(AGG)}
  62. }
  63. {
  64. {coalesce((select max(EXPR) from t1 where BOOL),EXPR)}
  65. {[coalesce_subquery [expr {EXPR}] [expr {BOOL}] [expr {EXPR}]]}
  66. }
  67. {
  68. {coalesce((select EXPR from t1 where BOOL),EXPR)}
  69. {[coalesce_subquery [expr {EXPR}] [expr {BOOL}] [expr {EXPR}]]}
  70. }
  71. }
  72. # The $boolexpr list contains terms that show both an SQL boolean
  73. # expression and its equivalent TCL.
  74. #
  75. set boolexpr {
  76. {EXPR=EXPR ((EXPR)==(EXPR))}
  77. {EXPR<EXPR ((EXPR)<(EXPR))}
  78. {EXPR>EXPR ((EXPR)>(EXPR))}
  79. {EXPR<=EXPR ((EXPR)<=(EXPR))}
  80. {EXPR>=EXPR ((EXPR)>=(EXPR))}
  81. {EXPR<>EXPR ((EXPR)!=(EXPR))}
  82. {
  83. {EXPR between EXPR and EXPR}
  84. {[betweenop [expr {EXPR}] [expr {EXPR}] [expr {EXPR}]]}
  85. }
  86. {
  87. {EXPR not between EXPR and EXPR}
  88. {(![betweenop [expr {EXPR}] [expr {EXPR}] [expr {EXPR}]])}
  89. }
  90. {
  91. {EXPR in (EXPR,EXPR,EXPR)}
  92. {([inop [expr {EXPR}] [expr {EXPR}] [expr {EXPR}] [expr {EXPR}]])}
  93. }
  94. {
  95. {EXPR not in (EXPR,EXPR,EXPR)}
  96. {(![inop [expr {EXPR}] [expr {EXPR}] [expr {EXPR}] [expr {EXPR}]])}
  97. }
  98. {
  99. {EXPR in (select EXPR from t1 union select EXPR from t1)}
  100. {[inop [expr {EXPR}] [expr {EXPR}] [expr {EXPR}]]}
  101. }
  102. {
  103. {EXPR in (select AGG from t1 union select AGG from t1)}
  104. {[inop [expr {EXPR}] [expr {AGG}] [expr {AGG}]]}
  105. }
  106. {
  107. {exists(select 1 from t1 where BOOL)}
  108. {(BOOL)}
  109. }
  110. {
  111. {not exists(select 1 from t1 where BOOL)}
  112. {!(BOOL)}
  113. }
  114. {{not BOOL} !BOOL}
  115. {{BOOL and BOOL} {BOOL tcland BOOL}}
  116. {{BOOL or BOOL} {BOOL || BOOL}}
  117. {{BOOL and BOOL} {BOOL tcland BOOL}}
  118. {{BOOL or BOOL} {BOOL || BOOL}}
  119. {(BOOL) (BOOL)}
  120. {(BOOL) (BOOL)}
  121. }
  122. # Aggregate expressions
  123. #
  124. set aggexpr {
  125. {count(*) wide(1)}
  126. {{count(distinct EXPR)} {[one {EXPR}]}}
  127. {{cast(avg(EXPR) AS integer)} (EXPR)}
  128. {min(EXPR) (EXPR)}
  129. {max(EXPR) (EXPR)}
  130. {(AGG) (AGG)}
  131. {{ -AGG} {-AGG}}
  132. {+AGG +AGG}
  133. {~AGG ~AGG}
  134. {abs(AGG) abs(AGG)}
  135. {AGG+AGG AGG+AGG}
  136. {AGG-AGG AGG-AGG}
  137. {AGG*AGG AGG*AGG}
  138. {{AGG | AGG} {AGG | AGG}}
  139. {
  140. {case AGG when AGG then AGG else AGG end}
  141. {(((AGG)==(AGG))?AGG:AGG)}
  142. }
  143. }
  144. # Convert a string containing EXPR, AGG, and BOOL into a string
  145. # that contains nothing but X, Y, and Z.
  146. #
  147. proc extract_vars {a} {
  148. regsub -all {EXPR} $a X a
  149. regsub -all {AGG} $a Y a
  150. regsub -all {BOOL} $a Z a
  151. regsub -all {[^XYZ]} $a {} a
  152. return $a
  153. }
  154. # Test all templates to make sure the number of EXPR, AGG, and BOOL
  155. # expressions match.
  156. #
  157. foreach term [concat $aggexpr $intexpr $boolexpr] {
  158. foreach {a b} $term break
  159. if {[extract_vars $a]!=[extract_vars $b]} {
  160. error "mismatch: $term"
  161. }
  162. }
  163. # Generate a random expression according to the templates given above.
  164. # If the argument is EXPR or omitted, then an integer expression is
  165. # generated. If the argument is BOOL then a boolean expression is
  166. # produced.
  167. #
  168. proc generate_expr {{e EXPR}} {
  169. set tcle $e
  170. set ne [llength $::intexpr]
  171. set nb [llength $::boolexpr]
  172. set na [llength $::aggexpr]
  173. set div 2
  174. set mx 50
  175. set i 0
  176. while {1} {
  177. set cnt 0
  178. set re [lindex $::intexpr [expr {int(rand()*$ne)}]]
  179. incr cnt [regsub {EXPR} $e [lindex $re 0] e]
  180. regsub {EXPR} $tcle [lindex $re 1] tcle
  181. set rb [lindex $::boolexpr [expr {int(rand()*$nb)}]]
  182. incr cnt [regsub {BOOL} $e [lindex $rb 0] e]
  183. regsub {BOOL} $tcle [lindex $rb 1] tcle
  184. set ra [lindex $::aggexpr [expr {int(rand()*$na)}]]
  185. incr cnt [regsub {AGG} $e [lindex $ra 0] e]
  186. regsub {AGG} $tcle [lindex $ra 1] tcle
  187. if {$cnt==0} break
  188. incr i $cnt
  189. set v1 [extract_vars $e]
  190. if {$v1!=[extract_vars $tcle]} {
  191. exit
  192. }
  193. if {$i+[string length $v1]>=$mx} {
  194. set ne [expr {$ne/$div}]
  195. set nb [expr {$nb/$div}]
  196. set na [expr {$na/$div}]
  197. set div 1
  198. set mx [expr {$mx*1000}]
  199. }
  200. }
  201. regsub -all { tcland } $tcle { \&\& } tcle
  202. return [list $e $tcle]
  203. }
  204. # Implementation of routines used to implement the IN and BETWEEN
  205. # operators.
  206. proc inop {lhs args} {
  207. foreach a $args {
  208. if {$a==$lhs} {return 1}
  209. }
  210. return 0
  211. }
  212. proc betweenop {lhs first second} {
  213. return [expr {$lhs>=$first && $lhs<=$second}]
  214. }
  215. proc coalesce_subquery {a b e} {
  216. if {$b} {
  217. return $a
  218. } else {
  219. return $e
  220. }
  221. }
  222. proc one {args} {
  223. return 1
  224. }
  225. # Begin generating the test script:
  226. #
  227. puts {# 2008 December 16
  228. #
  229. # The author disclaims copyright to this source code. In place of
  230. # a legal notice, here is a blessing:
  231. #
  232. # May you do good and not evil.
  233. # May you find forgiveness for yourself and forgive others.
  234. # May you share freely, never taking more than you give.
  235. #
  236. #***********************************************************************
  237. # This file implements regression tests for SQLite library.
  238. #
  239. # This file tests randomly generated SQL expressions. The expressions
  240. # are generated by a TCL script. The same TCL script also computes the
  241. # correct value of the expression. So, from one point of view, this
  242. # file verifies the expression evaluation logic of SQLite against the
  243. # expression evaluation logic of TCL.
  244. #
  245. # An early version of this script is how bug #3541 was detected.
  246. #
  247. # $Id: randexpr1.tcl,v 1.1 2008/12/15 16:33:30 drh Exp $
  248. set testdir [file dirname $argv0]
  249. source $testdir/tester.tcl
  250. # Create test data
  251. #
  252. do_test randexpr1-1.1 {
  253. db eval {
  254. CREATE TABLE t1(a,b,c,d,e,f);
  255. INSERT INTO t1 VALUES(100,200,300,400,500,600);
  256. SELECT * FROM t1
  257. }
  258. } {100 200 300 400 500 600}
  259. }
  260. # Test data for TCL evaluation.
  261. #
  262. set a [expr {wide(100)}]
  263. set b [expr {wide(200)}]
  264. set c [expr {wide(300)}]
  265. set d [expr {wide(400)}]
  266. set e [expr {wide(500)}]
  267. set f [expr {wide(600)}]
  268. # A procedure to generate a test case.
  269. #
  270. set tn 0
  271. proc make_test_case {sql result} {
  272. global tn
  273. incr tn
  274. puts "do_test randexpr-2.$tn {\n db eval {$sql}\n} {$result}"
  275. }
  276. # Generate many random test cases.
  277. #
  278. expr srand(0)
  279. for {set i 0} {$i<1000} {incr i} {
  280. while {1} {
  281. foreach {sqle tcle} [generate_expr EXPR] break;
  282. if {[catch {expr $tcle} ans]} {
  283. #puts stderr [list $tcle]
  284. #puts stderr ans=$ans
  285. if {![regexp {divide by zero} $ans]} exit
  286. continue
  287. }
  288. set len [string length $sqle]
  289. if {$len<100 || $len>2000} continue
  290. if {[info exists seen($sqle)]} continue
  291. set seen($sqle) 1
  292. break
  293. }
  294. while {1} {
  295. foreach {sqlb tclb} [generate_expr BOOL] break;
  296. if {[catch {expr $tclb} bans]} {
  297. #puts stderr [list $tclb]
  298. #puts stderr bans=$bans
  299. if {![regexp {divide by zero} $bans]} exit
  300. continue
  301. }
  302. break
  303. }
  304. if {$bans} {
  305. make_test_case "SELECT $sqle FROM t1 WHERE $sqlb" $ans
  306. make_test_case "SELECT $sqle FROM t1 WHERE NOT ($sqlb)" {}
  307. } else {
  308. make_test_case "SELECT $sqle FROM t1 WHERE $sqlb" {}
  309. make_test_case "SELECT $sqle FROM t1 WHERE NOT ($sqlb)" $ans
  310. }
  311. if {[regexp { \| } $sqle]} {
  312. regsub -all { \| } $sqle { \& } sqle
  313. regsub -all { \| } $tcle { \& } tcle
  314. if {[catch {expr $tcle} ans]==0} {
  315. if {$bans} {
  316. make_test_case "SELECT $sqle FROM t1 WHERE $sqlb" $ans
  317. } else {
  318. make_test_case "SELECT $sqle FROM t1 WHERE NOT ($sqlb)" $ans
  319. }
  320. }
  321. }
  322. }
  323. # Terminate the test script
  324. #
  325. puts {finish_test}