Index: src/expr.c ================================================================== --- src/expr.c +++ src/expr.c @@ -10,11 +10,11 @@ ** ************************************************************************* ** 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 /* @@ -1625,17 +1625,20 @@ /* ** 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){ - 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); + 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); + } } } /* Index: src/parse.y ================================================================== --- src/parse.y +++ src/parse.y @@ -12,11 +12,11 @@ ** 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_ @@ -657,11 +657,11 @@ 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 ){ Index: src/vdbeapi.c ================================================================== --- src/vdbeapi.c +++ src/vdbeapi.c @@ -496,10 +496,15 @@ ** 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); Index: test/fuzz.test ================================================================== --- test/fuzz.test +++ test/fuzz.test @@ -17,11 +17,11 @@ # 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 @@ -29,388 +29,11 @@ # 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]]] - - 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 ?? -# -# -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} - } -} +source $testdir/fuzz_common.tcl #---------------------------------------------------------------- # These tests caused errors that were first caught by the tests # in this file. They are still here. do_test fuzz-1.1 { ADDED test/fuzz_common.tcl Index: test/fuzz_common.tcl ================================================================== --- test/fuzz_common.tcl +++ test/fuzz_common.tcl @@ -0,0 +1,392 @@ +# 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 ?? +# +# -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} + } +} + ADDED test/fuzz_malloc.test Index: test/fuzz_malloc.test ================================================================== --- test/fuzz_malloc.test +++ test/fuzz_malloc.test @@ -0,0 +1,53 @@ +# +# 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 ?? +# +# -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 Index: test/malloc.test ================================================================== --- test/malloc.test +++ test/malloc.test @@ -12,11 +12,11 @@ # 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. @@ -25,105 +25,11 @@ puts "Skipping malloc tests: not compiled with -DSQLITE_MEMDEBUG..." finish_test return } -# Usage: do_malloc_test -# -# The first argument, , 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 - - 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 -} +source $testdir/malloc_common.tcl do_malloc_test 1 -tclprep { db close } -tclbody { if {[catch {sqlite3 db test.db}]} { ADDED test/mallocB.test Index: test/mallocB.test ================================================================== --- test/mallocB.test +++ test/mallocB.test @@ -0,0 +1,35 @@ +# 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 ADDED test/malloc_common.tcl Index: test/malloc_common.tcl ================================================================== --- test/malloc_common.tcl +++ test/malloc_common.tcl @@ -0,0 +1,101 @@ + +# Usage: do_malloc_test +# +# The first argument, , 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 +} + Index: test/quick.test ================================================================== --- test/quick.test +++ test/quick.test @@ -4,11 +4,11 @@ # 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] @@ -44,10 +44,11 @@ corrupt.test crash.test crash2.test exclusive3.test fuzz.test + fuzz_malloc.test in2.test loadext.test malloc.test malloc2.test malloc3.test Index: test/soak.test ================================================================== --- test/soak.test +++ test/soak.test @@ -9,11 +9,11 @@ # #*********************************************************************** # 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 {} {} @@ -58,10 +58,11 @@ # List of test files that are run by this file. # set SOAKTESTS { fuzz.test + fuzz_malloc.test trans.test } set ISQUICK 1