[sqlite] Remove obsolete reference version 3.8.7.4.

third_party/sqlite/sqlite-src-3080704/test/randexpr1.tcl

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