SQLite

**    May you find forgiveness for yourself and forgive others.
**    May you share freely, never taking more than you give.
**
*************************************************************************
** This file contains routines used for analyzing expressions and
** for generating VDBE code that evaluates expressions in SQLite.
**
** $Id: expr.c,v 1.295 2007/05/29 12:11:30 danielk1977 Exp $
** $Id: expr.c,v 1.296 2007/05/30 10:36:47 danielk1977 Exp $
*/
#include "sqliteInt.h"
#include <ctype.h>

/*
** Return the 'affinity' of the expression pExpr if any.
**

#endif /* SQLITE_OMIT_SUBQUERY */

/*
** Generate an instruction that will put the integer describe by
** text z[0..n-1] on the stack.
*/
static void codeInteger(Vdbe *v, const char *z, int n){
  assert( z || sqlite3MallocFailed() );
  if( z ){
  int i;
  if( sqlite3GetInt32(z, &i) ){
    sqlite3VdbeAddOp(v, OP_Integer, i, 0);
  }else if( sqlite3FitsIn64Bits(z) ){
    sqlite3VdbeOp3(v, OP_Int64, 0, 0, z, n);
  }else{
    sqlite3VdbeOp3(v, OP_Real, 0, 0, z, n);
    int i;
    if( sqlite3GetInt32(z, &i) ){
      sqlite3VdbeAddOp(v, OP_Integer, i, 0);
    }else if( sqlite3FitsIn64Bits(z) ){
      sqlite3VdbeOp3(v, OP_Int64, 0, 0, z, n);
    }else{
      sqlite3VdbeOp3(v, OP_Real, 0, 0, z, n);
    }
  }
}


/*
** Generate code that will extract the iColumn-th column from
** table pTab and push that column value on the stack.  There

**
*************************************************************************
** This file contains SQLite's grammar for SQL.  Process this file
** using the lemon parser generator to generate C code that runs
** the parser.  Lemon will also generate a header file containing
** numeric codes for all of the tokens.
**
** @(#) $Id: parse.y,v 1.228 2007/05/15 16:51:37 drh Exp $
** @(#) $Id: parse.y,v 1.229 2007/05/30 10:36:47 danielk1977 Exp $
*/

// All token codes are small integers with #defines that begin with "TK_"
%token_prefix TK_

// The type of the data attached to each token is Token.  This is also the
// default type for non-terminals.

%ifndef SQLITE_OMIT_CAST
expr(A) ::= CAST(X) LP expr(E) AS typetoken(T) RP(Y). {
  A = sqlite3Expr(TK_CAST, E, 0, &T);
  sqlite3ExprSpan(A,&X,&Y);
}
%endif  SQLITE_OMIT_CAST
expr(A) ::= ID(X) LP distinct(D) exprlist(Y) RP(E). {
  if( Y->nExpr>SQLITE_MAX_FUNCTION_ARG ){
  if( Y && Y->nExpr>SQLITE_MAX_FUNCTION_ARG ){
    sqlite3ErrorMsg(pParse, "too many arguments on function %T", &X);
  }
  A = sqlite3ExprFunction(Y, &X);
  sqlite3ExprSpan(A,&X,&E);
  if( D && A ){
    A->flags |= EP_Distinct;
  }

/**************************** sqlite3_column_  *******************************
** The following routines are used to access elements of the current row
** in the result set.
*/
const void *sqlite3_column_blob(sqlite3_stmt *pStmt, int i){
  const void *val;
  val = sqlite3_value_blob( columnMem(pStmt,i) );
  /* Even though there is no encoding conversion, value_blob() might
  ** need to call malloc() to expand the result of a zeroblob() 
  ** expression. 
  */
  columnMallocFailure(pStmt);
  return val;
}
int sqlite3_column_bytes(sqlite3_stmt *pStmt, int i){
  int val = sqlite3_value_bytes( columnMem(pStmt,i) );
  columnMallocFailure(pStmt);
  return val;
}

#
# The tests in this file are really about testing fuzzily generated
# SQL parse-trees. The majority of the fuzzily generated SQL is 
# valid as far as the parser is concerned. 
#
# The most complicated trees are for SELECT statements.
#
# $Id: fuzz.test,v 1.13 2007/05/30 08:18:04 danielk1977 Exp $
# $Id: fuzz.test,v 1.14 2007/05/30 10:36:47 danielk1977 Exp $

set testdir [file dirname $argv0]
source $testdir/tester.tcl

set ::REPEATS 5000

# If running quick.test, don't do so many iterations.
if {[info exists ::ISQUICK]} {
  if {$::ISQUICK} { set ::REPEATS 20 }
}

proc fuzz {TemplateList} {
  set n [llength $TemplateList]
  set i [expr {int(rand()*$n)}]
  set r [uplevel 1 subst -novar [list [lindex $TemplateList $i]]]

source $testdir/fuzz_common.tcl
  string map {"\n" " "} $r
}

# Fuzzy generation primitives:
#
#     Literal
#     UnaryOp
#     BinaryOp
#     Expr
#     Table
#     Select
#     Insert
#

# Returns a string representing an SQL literal.
#
proc Literal {} {
  set TemplateList {
    456 0 -456 1 -1 
    2147483648 2147483647 2147483649 -2147483647 -2147483648 -2147483649
    'The' 'first' 'experiments' 'in' 'hardware' 'fault' 'injection'
    zeroblob(1000)
    NULL
    56.1 -56.1
    123456789.1234567899
  }
  fuzz $TemplateList
}

# Returns a string containing an SQL unary operator (e.g. "+" or "NOT").
#
proc UnaryOp {} {
  set TemplateList {+ - NOT ~}
  fuzz $TemplateList
}

# Returns a string containing an SQL binary operator (e.g. "*" or "/").
#
proc BinaryOp {} {
  set TemplateList {
    || * / % + - << >> & | < <= > >= = == != <> AND OR
    LIKE GLOB {NOT LIKE}
  }
  fuzz $TemplateList
}

# Return the complete text of an SQL expression.
#
set ::ExprDepth 0
proc Expr { {c {}} } {
  incr ::ExprDepth

  set TemplateList [concat $c $c $c {[Literal]}]
  if {$::ExprDepth < 3} {
    lappend TemplateList \
      {[Expr $c] [BinaryOp] [Expr $c]}                              \
      {[UnaryOp] [Expr $c]}                                         \
      {[Expr $c] ISNULL}                                            \
      {[Expr $c] NOTNULL}                                           \
      {CAST([Expr $c] AS blob)}                                     \
      {CAST([Expr $c] AS text)}                                     \
      {CAST([Expr $c] AS integer)}                                  \
      {CAST([Expr $c] AS real)}                                     \
      {abs([Expr])}                                                 \
      {coalesce([Expr], [Expr])}                                    \
      {hex([Expr])}                                                 \
      {length([Expr])}                                              \
      {lower([Expr])}                                               \
      {upper([Expr])}                                               \
      {quote([Expr])}                                               \
      {random()}                                                    \
      {randomblob(min(max([Expr],1), 500))}                         \
      {typeof([Expr])}                                              \
      {substr([Expr],[Expr],[Expr])}                                \
      {CASE WHEN [Expr $c] THEN [Expr $c] ELSE [Expr $c] END}       \
      {[Literal]} {[Literal]} {[Literal]}                           \
      {[Literal]} {[Literal]} {[Literal]}                           \
      {[Literal]} {[Literal]} {[Literal]}                           \
      {[Literal]} {[Literal]} {[Literal]}
  }
  if {$::SelectDepth < 4} {
    lappend TemplateList \
      {([Select 1])}                       \
      {[Expr $c] IN ([Select 1])}          \
      {[Expr $c] NOT IN ([Select 1])}      \
      {EXISTS ([Select 1])}                \
  } 
  set res [fuzz $TemplateList]
  incr ::ExprDepth -1
  return $res
}

# Return a valid table name.
#
set ::TableList [list]
proc Table {} {
  set TemplateList [concat sqlite_master $::TableList]
  fuzz $TemplateList
}

# Return one of:
#
#     "SELECT DISTINCT", "SELECT ALL" or "SELECT"
#
proc SelectKw {} {
  set TemplateList {
    "SELECT DISTINCT"
    "SELECT ALL"
    "SELECT"
  }
  fuzz $TemplateList
}

# Return a result set for a SELECT statement.
#
proc ResultSet {{nRes 0} {c ""}} {
  if {$nRes == 0} {
    set nRes [expr {rand()*2 + 1}]
  }

  set aRes [list]
  for {set ii 0} {$ii < $nRes} {incr ii} {
    lappend aRes [Expr $c]
  }

  join $aRes ", "
}

set ::SelectDepth 0
set ::ColumnList [list]
proc SimpleSelect {{nRes 0}} {

  set TemplateList {
      {[SelectKw] [ResultSet $nRes]}
  }

  # The ::SelectDepth variable contains the number of ancestor SELECT
  # statements (i.e. for a top level SELECT it is set to 0, for a
  # sub-select 1, for a sub-select of a sub-select 2 etc.).
  #
  # If this is already greater than 3, do not generate a complicated
  # SELECT statement. This tends to cause parser stack overflow (too
  # boring to bother with).
  #
  if {$::SelectDepth < 4} {
    lappend TemplateList \
        {[SelectKw] [ResultSet $nRes $::ColumnList] FROM ([Select])}     \
        {[SelectKw] [ResultSet $nRes] FROM ([Select])}                   \
        {[SelectKw] [ResultSet $nRes $::ColumnList] FROM [Table]}        \
        {
             [SelectKw] [ResultSet $nRes $::ColumnList] 
             FROM ([Select]) 
             GROUP BY [Expr]
             HAVING [Expr]
        }                                                                \

    if {0 == $nRes} {
      lappend TemplateList                                               \
          {[SelectKw] * FROM ([Select])}                                 \
          {[SelectKw] * FROM [Table]}                                    \
          {[SelectKw] * FROM [Table] WHERE [Expr $::ColumnList]}         \
          {
             [SelectKw] * 
             FROM [Table],[Table] AS t2 
             WHERE [Expr $::ColumnList] 
          } {
             [SelectKw] * 
             FROM [Table] LEFT OUTER JOIN [Table] AS t2 
             ON [Expr $::ColumnList]
             WHERE [Expr $::ColumnList] 
          }
    }
  } 

  fuzz $TemplateList
}

# Return a SELECT statement.
#
# If boolean parameter $isExpr is set to true, make sure the
# returned SELECT statement returns a single column of data.
#
proc Select {{nMulti 0}} {
  set TemplateList {
    {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
    {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
    {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
    {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
    {[SimpleSelect $nMulti] ORDER BY [Expr] DESC}
    {[SimpleSelect $nMulti] ORDER BY [Expr] ASC}
    {[SimpleSelect $nMulti] ORDER BY [Expr] ASC, [Expr] DESC}
    {[SimpleSelect $nMulti] ORDER BY [Expr] LIMIT [Expr] OFFSET [Expr]}
  }

  if {$::SelectDepth < 4} {
    if {$nMulti == 0} {
      set nMulti [expr {(rand()*2)+1}]
    }
    lappend TemplateList                                             \
        {[SimpleSelect $nMulti] UNION     [Select $nMulti]}          \
        {[SimpleSelect $nMulti] UNION ALL [Select $nMulti]}          \
        {[SimpleSelect $nMulti] EXCEPT    [Select $nMulti]}          \
        {[SimpleSelect $nMulti] INTERSECT [Select $nMulti]}
  }

  incr ::SelectDepth
  set res [fuzz $TemplateList]
  incr ::SelectDepth -1
  set res
}

# Generate and return a fuzzy INSERT statement.
#
proc Insert {} {
  set TemplateList {
      {INSERT INTO [Table] VALUES([Expr], [Expr], [Expr]);}
      {INSERT INTO [Table] VALUES([Expr], [Expr], [Expr], [Expr]);}
      {INSERT INTO [Table] VALUES([Expr], [Expr]);}
  }
  fuzz $TemplateList
}

proc Column {} {
  fuzz $::ColumnList
}

# Generate and return a fuzzy UPDATE statement.
#
proc Update {} {
  set TemplateList {
    {UPDATE [Table] 
     SET [Column] = [Expr $::ColumnList] 
     WHERE [Expr $::ColumnList]}
  }
  fuzz $TemplateList
}

proc Delete {} {
  set TemplateList {
    {DELETE FROM [Table] WHERE [Expr $::ColumnList]}
  }
  fuzz $TemplateList
}

proc Statement {} {
  set TemplateList {
    {[Update]}
    {[Insert]}
    {[Select]}
    {[Delete]}
  }
  fuzz $TemplateList
}

# Return an identifier. This just chooses randomly from a fixed set
# of strings.
proc Identifier {} {
  set TemplateList {
    This just chooses randomly a fixed 
    We would also thank the developers 
    for their analysis Samba
  }
  fuzz $TemplateList
}

proc Check {} {
  # Use a large value for $::SelectDepth, because sub-selects are
  # not allowed in expressions used by CHECK constraints.
  #
  set sd $::SelectDepth 
  set ::SelectDepth 500
  set TemplateList {
    {}
    {CHECK ([Expr])}
  }
  set res [fuzz $TemplateList]
  set ::SelectDepth $sd
  set res
}

proc Coltype {} {
  set TemplateList {
    {INTEGER PRIMARY KEY}
    {VARCHAR [Check]}
    {PRIMARY KEY}
  }
  fuzz $TemplateList
}

proc DropTable {} {
  set TemplateList {
    {DROP TABLE IF EXISTS [Identifier]}
  }
  fuzz $TemplateList
}

proc CreateView {} {
  set TemplateList {
    {CREATE VIEW [Identifier] AS [Select]}
  }
  fuzz $TemplateList
}
proc DropView {} {
  set TemplateList {
    {DROP VIEW IF EXISTS [Identifier]}
  }
  fuzz $TemplateList
}

proc CreateTable {} {
  set TemplateList {
    {CREATE TABLE [Identifier]([Identifier] [Coltype], [Identifier] [Coltype])}
    {CREATE TEMP TABLE [Identifier]([Identifier] [Coltype])}
  }
  fuzz $TemplateList
}

proc CreateOrDropTableOrView {} {
  set TemplateList {
    {[CreateTable]}
    {[DropTable]}
    {[CreateView]}
    {[DropView]}
  }
  fuzz $TemplateList
}

########################################################################

set ::log [open fuzzy.log w]

#
# Usage: do_fuzzy_test <testname> ?<options>?
# 
#     -template
#     -errorlist
#     -repeats
#     
proc do_fuzzy_test {testname args} {
  set ::fuzzyopts(-errorlist) [list]
  set ::fuzzyopts(-repeats) $::REPEATS
  array set ::fuzzyopts $args

  lappend ::fuzzyopts(-errorlist) {parser stack overflow} 
  lappend ::fuzzyopts(-errorlist) {ORDER BY}
  lappend ::fuzzyopts(-errorlist) {GROUP BY}
  lappend ::fuzzyopts(-errorlist) {datatype mismatch}

  for {set ii 0} {$ii < $::fuzzyopts(-repeats)} {incr ii} {
    do_test ${testname}.$ii {
      set ::sql [subst $::fuzzyopts(-template)]
      puts $::log $::sql
      flush $::log
      set rc [catch {execsql $::sql} msg]
      set e 1
      if {$rc} {
        set e 0
        foreach error $::fuzzyopts(-errorlist) {
          if {0 == [string first $error $msg]} {
            set e 1
            break
          }
        }
      }
      if {$e == 0} {
        puts ""
        puts $::sql
        puts $msg
      }
      set e
    } {1}
  }
}

#----------------------------------------------------------------
# These tests caused errors that were first caught by the tests
# in this file. They are still here.
do_test fuzz-1.1 {
  execsql {
    SELECT 'abc' LIKE X'ABCD';

# 2007 May 10
#
# 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.
#
#***********************************************************************
#
# $Id: fuzz_common.tcl,v 1.1 2007/05/30 10:36:47 danielk1977 Exp $

proc fuzz {TemplateList} {
  set n [llength $TemplateList]
  set i [expr {int(rand()*$n)}]
  set r [uplevel 1 subst -novar [list [lindex $TemplateList $i]]]

  string map {"\n" " "} $r
}

# Fuzzy generation primitives:
#
#     Literal
#     UnaryOp
#     BinaryOp
#     Expr
#     Table
#     Select
#     Insert
#

# Returns a string representing an SQL literal.
#
proc Literal {} {
  set TemplateList {
    456 0 -456 1 -1 
    2147483648 2147483647 2147483649 -2147483647 -2147483648 -2147483649
    'The' 'first' 'experiments' 'in' 'hardware' 'fault' 'injection'
    zeroblob(1000)
    NULL
    56.1 -56.1
    123456789.1234567899
  }
  fuzz $TemplateList
}

# Returns a string containing an SQL unary operator (e.g. "+" or "NOT").
#
proc UnaryOp {} {
  set TemplateList {+ - NOT ~}
  fuzz $TemplateList
}

# Returns a string containing an SQL binary operator (e.g. "*" or "/").
#
proc BinaryOp {} {
  set TemplateList {
    || * / % + - << >> & | < <= > >= = == != <> AND OR
    LIKE GLOB {NOT LIKE}
  }
  fuzz $TemplateList
}

# Return the complete text of an SQL expression.
#
set ::ExprDepth 0
proc Expr { {c {}} } {
  incr ::ExprDepth

  set TemplateList [concat $c $c $c {[Literal]}]
  if {$::ExprDepth < 3} {
    lappend TemplateList \
      {[Expr $c] [BinaryOp] [Expr $c]}                              \
      {[UnaryOp] [Expr $c]}                                         \
      {[Expr $c] ISNULL}                                            \
      {[Expr $c] NOTNULL}                                           \
      {CAST([Expr $c] AS blob)}                                     \
      {CAST([Expr $c] AS text)}                                     \
      {CAST([Expr $c] AS integer)}                                  \
      {CAST([Expr $c] AS real)}                                     \
      {abs([Expr])}                                                 \
      {coalesce([Expr], [Expr])}                                    \
      {hex([Expr])}                                                 \
      {length([Expr])}                                              \
      {lower([Expr])}                                               \
      {upper([Expr])}                                               \
      {quote([Expr])}                                               \
      {random()}                                                    \
      {randomblob(min(max([Expr],1), 500))}                         \
      {typeof([Expr])}                                              \
      {substr([Expr],[Expr],[Expr])}                                \
      {CASE WHEN [Expr $c] THEN [Expr $c] ELSE [Expr $c] END}       \
      {[Literal]} {[Literal]} {[Literal]}                           \
      {[Literal]} {[Literal]} {[Literal]}                           \
      {[Literal]} {[Literal]} {[Literal]}                           \
      {[Literal]} {[Literal]} {[Literal]}
  }
  if {$::SelectDepth < 4} {
    lappend TemplateList \
      {([Select 1])}                       \
      {[Expr $c] IN ([Select 1])}          \
      {[Expr $c] NOT IN ([Select 1])}      \
      {EXISTS ([Select 1])}                \
  } 
  set res [fuzz $TemplateList]
  incr ::ExprDepth -1
  return $res
}

# Return a valid table name.
#
set ::TableList [list]
proc Table {} {
  set TemplateList [concat sqlite_master $::TableList]
  fuzz $TemplateList
}

# Return one of:
#
#     "SELECT DISTINCT", "SELECT ALL" or "SELECT"
#
proc SelectKw {} {
  set TemplateList {
    "SELECT DISTINCT"
    "SELECT ALL"
    "SELECT"
  }
  fuzz $TemplateList
}

# Return a result set for a SELECT statement.
#
proc ResultSet {{nRes 0} {c ""}} {
  if {$nRes == 0} {
    set nRes [expr {rand()*2 + 1}]
  }

  set aRes [list]
  for {set ii 0} {$ii < $nRes} {incr ii} {
    lappend aRes [Expr $c]
  }

  join $aRes ", "
}

set ::SelectDepth 0
set ::ColumnList [list]
proc SimpleSelect {{nRes 0}} {

  set TemplateList {
      {[SelectKw] [ResultSet $nRes]}
  }

  # The ::SelectDepth variable contains the number of ancestor SELECT
  # statements (i.e. for a top level SELECT it is set to 0, for a
  # sub-select 1, for a sub-select of a sub-select 2 etc.).
  #
  # If this is already greater than 3, do not generate a complicated
  # SELECT statement. This tends to cause parser stack overflow (too
  # boring to bother with).
  #
  if {$::SelectDepth < 4} {
    lappend TemplateList \
        {[SelectKw] [ResultSet $nRes $::ColumnList] FROM ([Select])}     \
        {[SelectKw] [ResultSet $nRes] FROM ([Select])}                   \
        {[SelectKw] [ResultSet $nRes $::ColumnList] FROM [Table]}        \
        {
             [SelectKw] [ResultSet $nRes $::ColumnList] 
             FROM ([Select]) 
             GROUP BY [Expr]
             HAVING [Expr]
        }                                                                \

    if {0 == $nRes} {
      lappend TemplateList                                               \
          {[SelectKw] * FROM ([Select])}                                 \
          {[SelectKw] * FROM [Table]}                                    \
          {[SelectKw] * FROM [Table] WHERE [Expr $::ColumnList]}         \
          {
             [SelectKw] * 
             FROM [Table],[Table] AS t2 
             WHERE [Expr $::ColumnList] 
          } {
             [SelectKw] * 
             FROM [Table] LEFT OUTER JOIN [Table] AS t2 
             ON [Expr $::ColumnList]
             WHERE [Expr $::ColumnList] 
          }
    }
  } 

  fuzz $TemplateList
}

# Return a SELECT statement.
#
# If boolean parameter $isExpr is set to true, make sure the
# returned SELECT statement returns a single column of data.
#
proc Select {{nMulti 0}} {
  set TemplateList {
    {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
    {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
    {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
    {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
    {[SimpleSelect $nMulti] ORDER BY [Expr] DESC}
    {[SimpleSelect $nMulti] ORDER BY [Expr] ASC}
    {[SimpleSelect $nMulti] ORDER BY [Expr] ASC, [Expr] DESC}
    {[SimpleSelect $nMulti] ORDER BY [Expr] LIMIT [Expr] OFFSET [Expr]}
  }

  if {$::SelectDepth < 4} {
    if {$nMulti == 0} {
      set nMulti [expr {(rand()*2)+1}]
    }
    lappend TemplateList                                             \
        {[SimpleSelect $nMulti] UNION     [Select $nMulti]}          \
        {[SimpleSelect $nMulti] UNION ALL [Select $nMulti]}          \
        {[SimpleSelect $nMulti] EXCEPT    [Select $nMulti]}          \
        {[SimpleSelect $nMulti] INTERSECT [Select $nMulti]}
  }

  incr ::SelectDepth
  set res [fuzz $TemplateList]
  incr ::SelectDepth -1
  set res
}

# Generate and return a fuzzy INSERT statement.
#
proc Insert {} {
  set TemplateList {
      {INSERT INTO [Table] VALUES([Expr], [Expr], [Expr]);}
      {INSERT INTO [Table] VALUES([Expr], [Expr], [Expr], [Expr]);}
      {INSERT INTO [Table] VALUES([Expr], [Expr]);}
  }
  fuzz $TemplateList
}

proc Column {} {
  fuzz $::ColumnList
}

# Generate and return a fuzzy UPDATE statement.
#
proc Update {} {
  set TemplateList {
    {UPDATE [Table] 
     SET [Column] = [Expr $::ColumnList] 
     WHERE [Expr $::ColumnList]}
  }
  fuzz $TemplateList
}

proc Delete {} {
  set TemplateList {
    {DELETE FROM [Table] WHERE [Expr $::ColumnList]}
  }
  fuzz $TemplateList
}

proc Statement {} {
  set TemplateList {
    {[Update]}
    {[Insert]}
    {[Select]}
    {[Delete]}
  }
  fuzz $TemplateList
}

# Return an identifier. This just chooses randomly from a fixed set
# of strings.
proc Identifier {} {
  set TemplateList {
    This just chooses randomly a fixed 
    We would also thank the developers 
    for their analysis Samba
  }
  fuzz $TemplateList
}

proc Check {} {
  # Use a large value for $::SelectDepth, because sub-selects are
  # not allowed in expressions used by CHECK constraints.
  #
  set sd $::SelectDepth 
  set ::SelectDepth 500
  set TemplateList {
    {}
    {CHECK ([Expr])}
  }
  set res [fuzz $TemplateList]
  set ::SelectDepth $sd
  set res
}

proc Coltype {} {
  set TemplateList {
    {INTEGER PRIMARY KEY}
    {VARCHAR [Check]}
    {PRIMARY KEY}
  }
  fuzz $TemplateList
}

proc DropTable {} {
  set TemplateList {
    {DROP TABLE IF EXISTS [Identifier]}
  }
  fuzz $TemplateList
}

proc CreateView {} {
  set TemplateList {
    {CREATE VIEW [Identifier] AS [Select]}
  }
  fuzz $TemplateList
}
proc DropView {} {
  set TemplateList {
    {DROP VIEW IF EXISTS [Identifier]}
  }
  fuzz $TemplateList
}

proc CreateTable {} {
  set TemplateList {
    {CREATE TABLE [Identifier]([Identifier] [Coltype], [Identifier] [Coltype])}
    {CREATE TEMP TABLE [Identifier]([Identifier] [Coltype])}
  }
  fuzz $TemplateList
}

proc CreateOrDropTableOrView {} {
  set TemplateList {
    {[CreateTable]}
    {[DropTable]}
    {[CreateView]}
    {[DropView]}
  }
  fuzz $TemplateList
}

########################################################################

set ::log [open fuzzy.log w]

#
# Usage: do_fuzzy_test <testname> ?<options>?
# 
#     -template
#     -errorlist
#     -repeats
#     
proc do_fuzzy_test {testname args} {
  set ::fuzzyopts(-errorlist) [list]
  set ::fuzzyopts(-repeats) $::REPEATS
  array set ::fuzzyopts $args

  lappend ::fuzzyopts(-errorlist) {parser stack overflow} 
  lappend ::fuzzyopts(-errorlist) {ORDER BY}
  lappend ::fuzzyopts(-errorlist) {GROUP BY}
  lappend ::fuzzyopts(-errorlist) {datatype mismatch}

  for {set ii 0} {$ii < $::fuzzyopts(-repeats)} {incr ii} {
    do_test ${testname}.$ii {
      set ::sql [subst $::fuzzyopts(-template)]
      puts $::log $::sql
      flush $::log
      set rc [catch {execsql $::sql} msg]
      set e 1
      if {$rc} {
        set e 0
        foreach error $::fuzzyopts(-errorlist) {
          if {0 == [string first $error $msg]} {
            set e 1
            break
          }
        }
      }
      if {$e == 0} {
        puts ""
        puts $::sql
        puts $msg
      }
      set e
    } {1}
  }
}

#
# 2007 May 10
#
# 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 tests malloc failures in concert with fuzzy SQL generation.
#
# $Id: fuzz_malloc.test,v 1.1 2007/05/30 10:36:47 danielk1977 Exp $

set testdir [file dirname $argv0]
source $testdir/tester.tcl
source $testdir/fuzz_common.tcl
source $testdir/malloc_common.tcl

set ::REPEATS 20

#
# Usage: do_fuzzy_malloc_test <testname> ?<options>?
# 
#     -template
#     -repeats
#     
proc do_fuzzy_malloc_test {testname args} {
  set ::fuzzyopts(-repeats) $::REPEATS
  array set ::fuzzyopts $args

  for {set ii 0} {$ii < $::fuzzyopts(-repeats)} {incr ii} {
    set ::sql [subst $::fuzzyopts(-template)]
    # puts $::sql
    foreach {rc res} [catchsql $::sql] {}
    if {$rc==0} {
      do_malloc_test $testname-$ii -sqlbody $::sql
    } else {
      incr ii -1
    }
  }
}

#----------------------------------------------------------------
# Test malloc failure during parsing (and execution) of a fuzzily 
# generated expressions.
#
do_fuzzy_malloc_test fuzzy_malloc-1 -template {Select [Expr]}

sqlite_malloc_fail 0
finish_test

#***********************************************************************
# This file attempts to check the library in an out-of-memory situation.
# When compiled with -DSQLITE_DEBUG=1, the SQLite library accepts a special
# command (sqlite_malloc_fail N) which causes the N-th malloc to fail.  This
# special feature is used to see what happens in the library if a malloc
# were to really fail due to an out-of-memory situation.
#
# $Id: malloc.test,v 1.41 2007/04/19 11:09:02 danielk1977 Exp $
# $Id: malloc.test,v 1.42 2007/05/30 10:36:47 danielk1977 Exp $

set testdir [file dirname $argv0]
source $testdir/tester.tcl

# Only run these tests if memory debugging is turned on.
#
if {[info command sqlite_malloc_stat]==""} {
   puts "Skipping malloc tests: not compiled with -DSQLITE_MEMDEBUG..."
   finish_test
   return
}

# Usage: do_malloc_test <test number> <options...>
#
# The first argument, <test number>, is an integer used to name the
# tests executed by this proc. Options are as follows:
#
#     -tclprep          TCL script to run to prepare test.
#     -sqlprep          SQL script to run to prepare test.
#     -tclbody          TCL script to run with malloc failure simulation.
#     -sqlbody          TCL script to run with malloc failure simulation.
#     -cleanup          TCL script to run after the test.
#
# This command runs a series of tests to verify SQLite's ability
# to handle an out-of-memory condition gracefully. It is assumed
# that if this condition occurs a malloc() call will return a
# NULL pointer. Linux, for example, doesn't do that by default. See
# the "BUGS" section of malloc(3).
#
# Each iteration of a loop, the TCL commands in any argument passed
# to the -tclbody switch, followed by the SQL commands in any argument
# passed to the -sqlbody switch are executed. Each iteration the
# Nth call to sqliteMalloc() is made to fail, where N is increased
# each time the loop runs starting from 1. When all commands execute
# successfully, the loop ends.
#
proc do_malloc_test {tn args} {
  array unset ::mallocopts 
  array set ::mallocopts $args

source $testdir/malloc_common.tcl
  set ::go 1
  for {set ::n 1} {$::go && $::n < 50000} {incr ::n} {
    do_test malloc-$tn.$::n {

      # Remove all traces of database files test.db and test2.db from the files
      # system. Then open (empty database) "test.db" with the handle [db].
      # 
      sqlite_malloc_fail 0
      catch {db close} 
      catch {file delete -force test.db}
      catch {file delete -force test.db-journal}
      catch {file delete -force test2.db}
      catch {file delete -force test2.db-journal}
      catch {sqlite3 db test.db} 
      set ::DB [sqlite3_connection_pointer db]

      # Execute any -tclprep and -sqlprep scripts.
      #
      if {[info exists ::mallocopts(-tclprep)]} {
        eval $::mallocopts(-tclprep)
      }
      if {[info exists ::mallocopts(-sqlprep)]} {
        execsql $::mallocopts(-sqlprep)
      }

      # Now set the ${::n}th malloc() to fail and execute the -tclbody and
      # -sqlbody scripts.
      #
      sqlite_malloc_fail $::n
      set ::mallocbody {}
      if {[info exists ::mallocopts(-tclbody)]} {
        append ::mallocbody "$::mallocopts(-tclbody)\n"
      }
      if {[info exists ::mallocopts(-sqlbody)]} {
        append ::mallocbody "db eval {$::mallocopts(-sqlbody)}"
      }
      set v [catch $::mallocbody msg]

      # If the test fails (if $v!=0) and the database connection actually
      # exists, make sure the failure code is SQLITE_NOMEM.
      if {$v && [info command db]=="db" && [info exists ::mallocopts(-sqlbody)]
              && [db errorcode]!=7} {
        set v 999
      }

      set leftover [lindex [sqlite_malloc_stat] 2]
      if {$leftover>0} {
        if {$leftover>1} {puts "\nLeftover: $leftover\nReturn=$v  Message=$msg"}
        set ::go 0
        if {$v} {
          puts "\nError message returned: $msg"
        } else {
          set v {1 1}
        }
      } else {
        set v2 [expr {$msg=="" || $msg=="out of memory"}]
        if {!$v2} {puts "\nError message returned: $msg"}
        lappend v $v2
      }
    } {1 1}

    if {[info exists ::mallocopts(-cleanup)]} {
      catch [list uplevel #0 $::mallocopts(-cleanup)] msg
    }
  }
  unset ::mallocopts
}

do_malloc_test 1 -tclprep {
  db close
} -tclbody {
  if {[catch {sqlite3 db test.db}]} {
    error "out of memory"
  }

# 2007 May 30
#
# 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 contains additional out-of-memory checks (see malloc.tcl).
# These were all discovered by fuzzy generation of SQL. Apart from
# that they have little in common.
#
# $Id: mallocB.test,v 1.1 2007/05/30 10:36:47 danielk1977 Exp $

set testdir [file dirname $argv0]
source $testdir/tester.tcl
source $testdir/malloc_common.tcl

# Only run these tests if memory debugging is turned on.
#
if {[info command sqlite_malloc_stat]==""} {
   puts "Skipping malloc tests: not compiled with -DSQLITE_MEMDEBUG..."
   finish_test
   return
}

do_malloc_test mallocB-1 -sqlbody {SELECT - 456}
do_malloc_test mallocB-2 -sqlbody {SELECT - 456.1}
do_malloc_test mallocB-3 -sqlbody {SELECT random()}
do_malloc_test mallocB-4 -sqlbody {SELECT zeroblob(1000)}

sqlite_malloc_fail 0
finish_test

# Usage: do_malloc_test <test number> <options...>
#
# The first argument, <test number>, is an integer used to name the
# tests executed by this proc. Options are as follows:
#
#     -tclprep          TCL script to run to prepare test.
#     -sqlprep          SQL script to run to prepare test.
#     -tclbody          TCL script to run with malloc failure simulation.
#     -sqlbody          TCL script to run with malloc failure simulation.
#     -cleanup          TCL script to run after the test.
#
# This command runs a series of tests to verify SQLite's ability
# to handle an out-of-memory condition gracefully. It is assumed
# that if this condition occurs a malloc() call will return a
# NULL pointer. Linux, for example, doesn't do that by default. See
# the "BUGS" section of malloc(3).
#
# Each iteration of a loop, the TCL commands in any argument passed
# to the -tclbody switch, followed by the SQL commands in any argument
# passed to the -sqlbody switch are executed. Each iteration the
# Nth call to sqliteMalloc() is made to fail, where N is increased
# each time the loop runs starting from 1. When all commands execute
# successfully, the loop ends.
#
proc do_malloc_test {tn args} {
  array unset ::mallocopts 
  array set ::mallocopts $args

  if {[string is integer $tn]} {
    set tn malloc-$tn
  }

  set ::go 1
  for {set ::n 1} {$::go && $::n < 50000} {incr ::n} {
    do_test $tn.$::n {

      # Remove all traces of database files test.db and test2.db from the files
      # system. Then open (empty database) "test.db" with the handle [db].
      # 
      sqlite_malloc_fail 0
      catch {db close} 
      catch {file delete -force test.db}
      catch {file delete -force test.db-journal}
      catch {file delete -force test2.db}
      catch {file delete -force test2.db-journal}
      catch {sqlite3 db test.db} 
      set ::DB [sqlite3_connection_pointer db]

      # Execute any -tclprep and -sqlprep scripts.
      #
      if {[info exists ::mallocopts(-tclprep)]} {
        eval $::mallocopts(-tclprep)
      }
      if {[info exists ::mallocopts(-sqlprep)]} {
        execsql $::mallocopts(-sqlprep)
      }

      # Now set the ${::n}th malloc() to fail and execute the -tclbody and
      # -sqlbody scripts.
      #
      sqlite_malloc_fail $::n
      set ::mallocbody {}
      if {[info exists ::mallocopts(-tclbody)]} {
        append ::mallocbody "$::mallocopts(-tclbody)\n"
      }
      if {[info exists ::mallocopts(-sqlbody)]} {
        append ::mallocbody "db eval {$::mallocopts(-sqlbody)}"
      }
      set v [catch $::mallocbody msg]

      # If the test fails (if $v!=0) and the database connection actually
      # exists, make sure the failure code is SQLITE_NOMEM.
      if {$v && [info command db]=="db" && [info exists ::mallocopts(-sqlbody)]
              && [db errorcode]!=7} {
        set v 999
      }

      set leftover [lindex [sqlite_malloc_stat] 2]
      if {$leftover>0} {
        if {$leftover>1} {puts "\nLeftover: $leftover\nReturn=$v  Message=$msg"}
        set ::go 0
        if {$v} {
          puts "\nError message returned: $msg"
        } else {
          set v {1 1}
        }
      } else {
        set v2 [expr {$msg=="" || $msg=="out of memory"}]
        if {!$v2} {puts "\nError message returned: $msg"}
        lappend v $v2
      }
    } {1 1}

    if {[info exists ::mallocopts(-cleanup)]} {
      catch [list uplevel #0 $::mallocopts(-cleanup)] msg
    }
  }
  unset ::mallocopts
}

#
#    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 runs all tests.
#
# $Id: quick.test,v 1.57 2007/05/30 08:18:04 danielk1977 Exp $
# $Id: quick.test,v 1.58 2007/05/30 10:36:47 danielk1977 Exp $

proc lshift {lvar} {
  upvar $lvar l
  set ret [lindex $l 0]
  set l [lrange $l 1 end]
  return $ret
}

  btree5.test
  btree6.test
  corrupt.test
  crash.test
  crash2.test
  exclusive3.test
  fuzz.test
  fuzz_malloc.test
  in2.test
  loadext.test
  malloc.test
  malloc2.test
  malloc3.test
  memleak.test
  misc7.test

# 2007 May 24
#
# 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 is the driver for the "soak" tests. It is a peer of the
# quick.test and all.test scripts.
#
# $Id: soak.test,v 1.1 2007/05/30 08:18:04 danielk1977 Exp $
# $Id: soak.test,v 1.2 2007/05/30 10:36:47 danielk1977 Exp $

set testdir [file dirname $argv0]
source $testdir/tester.tcl
rename finish_test really_finish_test
proc finish_test {} {}

# By default, guarantee that the tests will run for at least 1 hour.

# Storing checksums etc.
#

# List of test files that are run by this file.
#
set SOAKTESTS {
  fuzz.test
  fuzz_malloc.test
  trans.test
}

set ISQUICK 1

set soak_starttime  [clock seconds]
set soak_finishtime [expr {$soak_starttime + $TIMEOUT}]