/ Check-in [7522d2fb]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Add some extra tests for malloc failure during expression parsing and execution using fuzzily generated SQL. (CVS 4043)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 7522d2fb3204d107b8b4816d7f39c88741f20230
User & Date: danielk1977 2007-05-30 10:36:47
Context
2007-05-31
08:20
Extend out-of-memory testing with fuzzily generated sql some. One fix for a problem found by the same. (CVS 4044) check-in: d2282e64 user: danielk1977 tags: trunk
2007-05-30
10:36
Add some extra tests for malloc failure during expression parsing and execution using fuzzily generated SQL. (CVS 4043) check-in: 7522d2fb user: danielk1977 tags: trunk
08:18
Add the start of the soak-test infrastructure. (CVS 4042) check-in: 5d0b247c user: danielk1977 tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to src/expr.c.

     8      8   **    May you find forgiveness for yourself and forgive others.
     9      9   **    May you share freely, never taking more than you give.
    10     10   **
    11     11   *************************************************************************
    12     12   ** This file contains routines used for analyzing expressions and
    13     13   ** for generating VDBE code that evaluates expressions in SQLite.
    14     14   **
    15         -** $Id: expr.c,v 1.295 2007/05/29 12:11:30 danielk1977 Exp $
           15  +** $Id: expr.c,v 1.296 2007/05/30 10:36:47 danielk1977 Exp $
    16     16   */
    17     17   #include "sqliteInt.h"
    18     18   #include <ctype.h>
    19     19   
    20     20   /*
    21     21   ** Return the 'affinity' of the expression pExpr if any.
    22     22   **
................................................................................
  1623   1623   #endif /* SQLITE_OMIT_SUBQUERY */
  1624   1624   
  1625   1625   /*
  1626   1626   ** Generate an instruction that will put the integer describe by
  1627   1627   ** text z[0..n-1] on the stack.
  1628   1628   */
  1629   1629   static void codeInteger(Vdbe *v, const char *z, int n){
  1630         -  int i;
  1631         -  if( sqlite3GetInt32(z, &i) ){
  1632         -    sqlite3VdbeAddOp(v, OP_Integer, i, 0);
  1633         -  }else if( sqlite3FitsIn64Bits(z) ){
  1634         -    sqlite3VdbeOp3(v, OP_Int64, 0, 0, z, n);
  1635         -  }else{
  1636         -    sqlite3VdbeOp3(v, OP_Real, 0, 0, z, n);
         1630  +  assert( z || sqlite3MallocFailed() );
         1631  +  if( z ){
         1632  +    int i;
         1633  +    if( sqlite3GetInt32(z, &i) ){
         1634  +      sqlite3VdbeAddOp(v, OP_Integer, i, 0);
         1635  +    }else if( sqlite3FitsIn64Bits(z) ){
         1636  +      sqlite3VdbeOp3(v, OP_Int64, 0, 0, z, n);
         1637  +    }else{
         1638  +      sqlite3VdbeOp3(v, OP_Real, 0, 0, z, n);
         1639  +    }
  1637   1640     }
  1638   1641   }
  1639   1642   
  1640   1643   
  1641   1644   /*
  1642   1645   ** Generate code that will extract the iColumn-th column from
  1643   1646   ** table pTab and push that column value on the stack.  There

Changes to src/parse.y.

    10     10   **
    11     11   *************************************************************************
    12     12   ** This file contains SQLite's grammar for SQL.  Process this file
    13     13   ** using the lemon parser generator to generate C code that runs
    14     14   ** the parser.  Lemon will also generate a header file containing
    15     15   ** numeric codes for all of the tokens.
    16     16   **
    17         -** @(#) $Id: parse.y,v 1.228 2007/05/15 16:51:37 drh Exp $
           17  +** @(#) $Id: parse.y,v 1.229 2007/05/30 10:36:47 danielk1977 Exp $
    18     18   */
    19     19   
    20     20   // All token codes are small integers with #defines that begin with "TK_"
    21     21   %token_prefix TK_
    22     22   
    23     23   // The type of the data attached to each token is Token.  This is also the
    24     24   // default type for non-terminals.
................................................................................
   655    655   %ifndef SQLITE_OMIT_CAST
   656    656   expr(A) ::= CAST(X) LP expr(E) AS typetoken(T) RP(Y). {
   657    657     A = sqlite3Expr(TK_CAST, E, 0, &T);
   658    658     sqlite3ExprSpan(A,&X,&Y);
   659    659   }
   660    660   %endif  SQLITE_OMIT_CAST
   661    661   expr(A) ::= ID(X) LP distinct(D) exprlist(Y) RP(E). {
   662         -  if( Y->nExpr>SQLITE_MAX_FUNCTION_ARG ){
          662  +  if( Y && Y->nExpr>SQLITE_MAX_FUNCTION_ARG ){
   663    663       sqlite3ErrorMsg(pParse, "too many arguments on function %T", &X);
   664    664     }
   665    665     A = sqlite3ExprFunction(Y, &X);
   666    666     sqlite3ExprSpan(A,&X,&E);
   667    667     if( D && A ){
   668    668       A->flags |= EP_Distinct;
   669    669     }

Changes to src/vdbeapi.c.

   494    494   /**************************** sqlite3_column_  *******************************
   495    495   ** The following routines are used to access elements of the current row
   496    496   ** in the result set.
   497    497   */
   498    498   const void *sqlite3_column_blob(sqlite3_stmt *pStmt, int i){
   499    499     const void *val;
   500    500     val = sqlite3_value_blob( columnMem(pStmt,i) );
          501  +  /* Even though there is no encoding conversion, value_blob() might
          502  +  ** need to call malloc() to expand the result of a zeroblob() 
          503  +  ** expression. 
          504  +  */
          505  +  columnMallocFailure(pStmt);
   501    506     return val;
   502    507   }
   503    508   int sqlite3_column_bytes(sqlite3_stmt *pStmt, int i){
   504    509     int val = sqlite3_value_bytes( columnMem(pStmt,i) );
   505    510     columnMallocFailure(pStmt);
   506    511     return val;
   507    512   }

Changes to test/fuzz.test.

    15     15   #
    16     16   # The tests in this file are really about testing fuzzily generated
    17     17   # SQL parse-trees. The majority of the fuzzily generated SQL is 
    18     18   # valid as far as the parser is concerned. 
    19     19   #
    20     20   # The most complicated trees are for SELECT statements.
    21     21   #
    22         -# $Id: fuzz.test,v 1.13 2007/05/30 08:18:04 danielk1977 Exp $
           22  +# $Id: fuzz.test,v 1.14 2007/05/30 10:36:47 danielk1977 Exp $
    23     23   
    24     24   set testdir [file dirname $argv0]
    25     25   source $testdir/tester.tcl
    26     26   
    27     27   set ::REPEATS 5000
    28     28   
    29     29   # If running quick.test, don't do so many iterations.
    30     30   if {[info exists ::ISQUICK]} {
    31     31     if {$::ISQUICK} { set ::REPEATS 20 }
    32     32   }
    33     33   
    34         -proc fuzz {TemplateList} {
    35         -  set n [llength $TemplateList]
    36         -  set i [expr {int(rand()*$n)}]
    37         -  set r [uplevel 1 subst -novar [list [lindex $TemplateList $i]]]
    38         -
    39         -  string map {"\n" " "} $r
    40         -}
    41         -
    42         -# Fuzzy generation primitives:
    43         -#
    44         -#     Literal
    45         -#     UnaryOp
    46         -#     BinaryOp
    47         -#     Expr
    48         -#     Table
    49         -#     Select
    50         -#     Insert
    51         -#
    52         -
    53         -# Returns a string representing an SQL literal.
    54         -#
    55         -proc Literal {} {
    56         -  set TemplateList {
    57         -    456 0 -456 1 -1 
    58         -    2147483648 2147483647 2147483649 -2147483647 -2147483648 -2147483649
    59         -    'The' 'first' 'experiments' 'in' 'hardware' 'fault' 'injection'
    60         -    zeroblob(1000)
    61         -    NULL
    62         -    56.1 -56.1
    63         -    123456789.1234567899
    64         -  }
    65         -  fuzz $TemplateList
    66         -}
    67         -
    68         -# Returns a string containing an SQL unary operator (e.g. "+" or "NOT").
    69         -#
    70         -proc UnaryOp {} {
    71         -  set TemplateList {+ - NOT ~}
    72         -  fuzz $TemplateList
    73         -}
    74         -
    75         -# Returns a string containing an SQL binary operator (e.g. "*" or "/").
    76         -#
    77         -proc BinaryOp {} {
    78         -  set TemplateList {
    79         -    || * / % + - << >> & | < <= > >= = == != <> AND OR
    80         -    LIKE GLOB {NOT LIKE}
    81         -  }
    82         -  fuzz $TemplateList
    83         -}
    84         -
    85         -# Return the complete text of an SQL expression.
    86         -#
    87         -set ::ExprDepth 0
    88         -proc Expr { {c {}} } {
    89         -  incr ::ExprDepth
    90         -
    91         -  set TemplateList [concat $c $c $c {[Literal]}]
    92         -  if {$::ExprDepth < 3} {
    93         -    lappend TemplateList \
    94         -      {[Expr $c] [BinaryOp] [Expr $c]}                              \
    95         -      {[UnaryOp] [Expr $c]}                                         \
    96         -      {[Expr $c] ISNULL}                                            \
    97         -      {[Expr $c] NOTNULL}                                           \
    98         -      {CAST([Expr $c] AS blob)}                                     \
    99         -      {CAST([Expr $c] AS text)}                                     \
   100         -      {CAST([Expr $c] AS integer)}                                  \
   101         -      {CAST([Expr $c] AS real)}                                     \
   102         -      {abs([Expr])}                                                 \
   103         -      {coalesce([Expr], [Expr])}                                    \
   104         -      {hex([Expr])}                                                 \
   105         -      {length([Expr])}                                              \
   106         -      {lower([Expr])}                                               \
   107         -      {upper([Expr])}                                               \
   108         -      {quote([Expr])}                                               \
   109         -      {random()}                                                    \
   110         -      {randomblob(min(max([Expr],1), 500))}                         \
   111         -      {typeof([Expr])}                                              \
   112         -      {substr([Expr],[Expr],[Expr])}                                \
   113         -      {CASE WHEN [Expr $c] THEN [Expr $c] ELSE [Expr $c] END}       \
   114         -      {[Literal]} {[Literal]} {[Literal]}                           \
   115         -      {[Literal]} {[Literal]} {[Literal]}                           \
   116         -      {[Literal]} {[Literal]} {[Literal]}                           \
   117         -      {[Literal]} {[Literal]} {[Literal]}
   118         -  }
   119         -  if {$::SelectDepth < 4} {
   120         -    lappend TemplateList \
   121         -      {([Select 1])}                       \
   122         -      {[Expr $c] IN ([Select 1])}          \
   123         -      {[Expr $c] NOT IN ([Select 1])}      \
   124         -      {EXISTS ([Select 1])}                \
   125         -  } 
   126         -  set res [fuzz $TemplateList]
   127         -  incr ::ExprDepth -1
   128         -  return $res
   129         -}
   130         -
   131         -# Return a valid table name.
   132         -#
   133         -set ::TableList [list]
   134         -proc Table {} {
   135         -  set TemplateList [concat sqlite_master $::TableList]
   136         -  fuzz $TemplateList
   137         -}
   138         -
   139         -# Return one of:
   140         -#
   141         -#     "SELECT DISTINCT", "SELECT ALL" or "SELECT"
   142         -#
   143         -proc SelectKw {} {
   144         -  set TemplateList {
   145         -    "SELECT DISTINCT"
   146         -    "SELECT ALL"
   147         -    "SELECT"
   148         -  }
   149         -  fuzz $TemplateList
   150         -}
   151         -
   152         -# Return a result set for a SELECT statement.
   153         -#
   154         -proc ResultSet {{nRes 0} {c ""}} {
   155         -  if {$nRes == 0} {
   156         -    set nRes [expr {rand()*2 + 1}]
   157         -  }
   158         -
   159         -  set aRes [list]
   160         -  for {set ii 0} {$ii < $nRes} {incr ii} {
   161         -    lappend aRes [Expr $c]
   162         -  }
   163         -
   164         -  join $aRes ", "
   165         -}
   166         -
   167         -set ::SelectDepth 0
   168         -set ::ColumnList [list]
   169         -proc SimpleSelect {{nRes 0}} {
   170         -
   171         -  set TemplateList {
   172         -      {[SelectKw] [ResultSet $nRes]}
   173         -  }
   174         -
   175         -  # The ::SelectDepth variable contains the number of ancestor SELECT
   176         -  # statements (i.e. for a top level SELECT it is set to 0, for a
   177         -  # sub-select 1, for a sub-select of a sub-select 2 etc.).
   178         -  #
   179         -  # If this is already greater than 3, do not generate a complicated
   180         -  # SELECT statement. This tends to cause parser stack overflow (too
   181         -  # boring to bother with).
   182         -  #
   183         -  if {$::SelectDepth < 4} {
   184         -    lappend TemplateList \
   185         -        {[SelectKw] [ResultSet $nRes $::ColumnList] FROM ([Select])}     \
   186         -        {[SelectKw] [ResultSet $nRes] FROM ([Select])}                   \
   187         -        {[SelectKw] [ResultSet $nRes $::ColumnList] FROM [Table]}        \
   188         -        {
   189         -             [SelectKw] [ResultSet $nRes $::ColumnList] 
   190         -             FROM ([Select]) 
   191         -             GROUP BY [Expr]
   192         -             HAVING [Expr]
   193         -        }                                                                \
   194         -
   195         -    if {0 == $nRes} {
   196         -      lappend TemplateList                                               \
   197         -          {[SelectKw] * FROM ([Select])}                                 \
   198         -          {[SelectKw] * FROM [Table]}                                    \
   199         -          {[SelectKw] * FROM [Table] WHERE [Expr $::ColumnList]}         \
   200         -          {
   201         -             [SelectKw] * 
   202         -             FROM [Table],[Table] AS t2 
   203         -             WHERE [Expr $::ColumnList] 
   204         -          } {
   205         -             [SelectKw] * 
   206         -             FROM [Table] LEFT OUTER JOIN [Table] AS t2 
   207         -             ON [Expr $::ColumnList]
   208         -             WHERE [Expr $::ColumnList] 
   209         -          }
   210         -    }
   211         -  } 
   212         -
   213         -  fuzz $TemplateList
   214         -}
   215         -
   216         -# Return a SELECT statement.
   217         -#
   218         -# If boolean parameter $isExpr is set to true, make sure the
   219         -# returned SELECT statement returns a single column of data.
   220         -#
   221         -proc Select {{nMulti 0}} {
   222         -  set TemplateList {
   223         -    {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
   224         -    {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
   225         -    {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
   226         -    {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
   227         -    {[SimpleSelect $nMulti] ORDER BY [Expr] DESC}
   228         -    {[SimpleSelect $nMulti] ORDER BY [Expr] ASC}
   229         -    {[SimpleSelect $nMulti] ORDER BY [Expr] ASC, [Expr] DESC}
   230         -    {[SimpleSelect $nMulti] ORDER BY [Expr] LIMIT [Expr] OFFSET [Expr]}
   231         -  }
   232         -
   233         -  if {$::SelectDepth < 4} {
   234         -    if {$nMulti == 0} {
   235         -      set nMulti [expr {(rand()*2)+1}]
   236         -    }
   237         -    lappend TemplateList                                             \
   238         -        {[SimpleSelect $nMulti] UNION     [Select $nMulti]}          \
   239         -        {[SimpleSelect $nMulti] UNION ALL [Select $nMulti]}          \
   240         -        {[SimpleSelect $nMulti] EXCEPT    [Select $nMulti]}          \
   241         -        {[SimpleSelect $nMulti] INTERSECT [Select $nMulti]}
   242         -  }
   243         -
   244         -  incr ::SelectDepth
   245         -  set res [fuzz $TemplateList]
   246         -  incr ::SelectDepth -1
   247         -  set res
   248         -}
   249         -
   250         -# Generate and return a fuzzy INSERT statement.
   251         -#
   252         -proc Insert {} {
   253         -  set TemplateList {
   254         -      {INSERT INTO [Table] VALUES([Expr], [Expr], [Expr]);}
   255         -      {INSERT INTO [Table] VALUES([Expr], [Expr], [Expr], [Expr]);}
   256         -      {INSERT INTO [Table] VALUES([Expr], [Expr]);}
   257         -  }
   258         -  fuzz $TemplateList
   259         -}
   260         -
   261         -proc Column {} {
   262         -  fuzz $::ColumnList
   263         -}
   264         -
   265         -# Generate and return a fuzzy UPDATE statement.
   266         -#
   267         -proc Update {} {
   268         -  set TemplateList {
   269         -    {UPDATE [Table] 
   270         -     SET [Column] = [Expr $::ColumnList] 
   271         -     WHERE [Expr $::ColumnList]}
   272         -  }
   273         -  fuzz $TemplateList
   274         -}
   275         -
   276         -proc Delete {} {
   277         -  set TemplateList {
   278         -    {DELETE FROM [Table] WHERE [Expr $::ColumnList]}
   279         -  }
   280         -  fuzz $TemplateList
   281         -}
   282         -
   283         -proc Statement {} {
   284         -  set TemplateList {
   285         -    {[Update]}
   286         -    {[Insert]}
   287         -    {[Select]}
   288         -    {[Delete]}
   289         -  }
   290         -  fuzz $TemplateList
   291         -}
   292         -
   293         -# Return an identifier. This just chooses randomly from a fixed set
   294         -# of strings.
   295         -proc Identifier {} {
   296         -  set TemplateList {
   297         -    This just chooses randomly a fixed 
   298         -    We would also thank the developers 
   299         -    for their analysis Samba
   300         -  }
   301         -  fuzz $TemplateList
   302         -}
   303         -
   304         -proc Check {} {
   305         -  # Use a large value for $::SelectDepth, because sub-selects are
   306         -  # not allowed in expressions used by CHECK constraints.
   307         -  #
   308         -  set sd $::SelectDepth 
   309         -  set ::SelectDepth 500
   310         -  set TemplateList {
   311         -    {}
   312         -    {CHECK ([Expr])}
   313         -  }
   314         -  set res [fuzz $TemplateList]
   315         -  set ::SelectDepth $sd
   316         -  set res
   317         -}
   318         -
   319         -proc Coltype {} {
   320         -  set TemplateList {
   321         -    {INTEGER PRIMARY KEY}
   322         -    {VARCHAR [Check]}
   323         -    {PRIMARY KEY}
   324         -  }
   325         -  fuzz $TemplateList
   326         -}
   327         -
   328         -proc DropTable {} {
   329         -  set TemplateList {
   330         -    {DROP TABLE IF EXISTS [Identifier]}
   331         -  }
   332         -  fuzz $TemplateList
   333         -}
   334         -
   335         -proc CreateView {} {
   336         -  set TemplateList {
   337         -    {CREATE VIEW [Identifier] AS [Select]}
   338         -  }
   339         -  fuzz $TemplateList
   340         -}
   341         -proc DropView {} {
   342         -  set TemplateList {
   343         -    {DROP VIEW IF EXISTS [Identifier]}
   344         -  }
   345         -  fuzz $TemplateList
   346         -}
   347         -
   348         -proc CreateTable {} {
   349         -  set TemplateList {
   350         -    {CREATE TABLE [Identifier]([Identifier] [Coltype], [Identifier] [Coltype])}
   351         -    {CREATE TEMP TABLE [Identifier]([Identifier] [Coltype])}
   352         -  }
   353         -  fuzz $TemplateList
   354         -}
   355         -
   356         -proc CreateOrDropTableOrView {} {
   357         -  set TemplateList {
   358         -    {[CreateTable]}
   359         -    {[DropTable]}
   360         -    {[CreateView]}
   361         -    {[DropView]}
   362         -  }
   363         -  fuzz $TemplateList
   364         -}
   365         -
   366         -########################################################################
   367         -
   368         -set ::log [open fuzzy.log w]
   369         -
   370         -#
   371         -# Usage: do_fuzzy_test <testname> ?<options>?
   372         -# 
   373         -#     -template
   374         -#     -errorlist
   375         -#     -repeats
   376         -#     
   377         -proc do_fuzzy_test {testname args} {
   378         -  set ::fuzzyopts(-errorlist) [list]
   379         -  set ::fuzzyopts(-repeats) $::REPEATS
   380         -  array set ::fuzzyopts $args
   381         -
   382         -  lappend ::fuzzyopts(-errorlist) {parser stack overflow} 
   383         -  lappend ::fuzzyopts(-errorlist) {ORDER BY}
   384         -  lappend ::fuzzyopts(-errorlist) {GROUP BY}
   385         -  lappend ::fuzzyopts(-errorlist) {datatype mismatch}
   386         -
   387         -  for {set ii 0} {$ii < $::fuzzyopts(-repeats)} {incr ii} {
   388         -    do_test ${testname}.$ii {
   389         -      set ::sql [subst $::fuzzyopts(-template)]
   390         -      puts $::log $::sql
   391         -      flush $::log
   392         -      set rc [catch {execsql $::sql} msg]
   393         -      set e 1
   394         -      if {$rc} {
   395         -        set e 0
   396         -        foreach error $::fuzzyopts(-errorlist) {
   397         -          if {0 == [string first $error $msg]} {
   398         -            set e 1
   399         -            break
   400         -          }
   401         -        }
   402         -      }
   403         -      if {$e == 0} {
   404         -        puts ""
   405         -        puts $::sql
   406         -        puts $msg
   407         -      }
   408         -      set e
   409         -    } {1}
   410         -  }
   411         -}
           34  +source $testdir/fuzz_common.tcl
   412     35   
   413     36   #----------------------------------------------------------------
   414     37   # These tests caused errors that were first caught by the tests
   415     38   # in this file. They are still here.
   416     39   do_test fuzz-1.1 {
   417     40     execsql {
   418     41       SELECT 'abc' LIKE X'ABCD';

Added test/fuzz_common.tcl.

            1  +# 2007 May 10
            2  +#
            3  +# The author disclaims copyright to this source code.  In place of
            4  +# a legal notice, here is a blessing:
            5  +#
            6  +#    May you do good and not evil.
            7  +#    May you find forgiveness for yourself and forgive others.
            8  +#    May you share freely, never taking more than you give.
            9  +#
           10  +#***********************************************************************
           11  +#
           12  +# $Id: fuzz_common.tcl,v 1.1 2007/05/30 10:36:47 danielk1977 Exp $
           13  +
           14  +proc fuzz {TemplateList} {
           15  +  set n [llength $TemplateList]
           16  +  set i [expr {int(rand()*$n)}]
           17  +  set r [uplevel 1 subst -novar [list [lindex $TemplateList $i]]]
           18  +
           19  +  string map {"\n" " "} $r
           20  +}
           21  +
           22  +# Fuzzy generation primitives:
           23  +#
           24  +#     Literal
           25  +#     UnaryOp
           26  +#     BinaryOp
           27  +#     Expr
           28  +#     Table
           29  +#     Select
           30  +#     Insert
           31  +#
           32  +
           33  +# Returns a string representing an SQL literal.
           34  +#
           35  +proc Literal {} {
           36  +  set TemplateList {
           37  +    456 0 -456 1 -1 
           38  +    2147483648 2147483647 2147483649 -2147483647 -2147483648 -2147483649
           39  +    'The' 'first' 'experiments' 'in' 'hardware' 'fault' 'injection'
           40  +    zeroblob(1000)
           41  +    NULL
           42  +    56.1 -56.1
           43  +    123456789.1234567899
           44  +  }
           45  +  fuzz $TemplateList
           46  +}
           47  +
           48  +# Returns a string containing an SQL unary operator (e.g. "+" or "NOT").
           49  +#
           50  +proc UnaryOp {} {
           51  +  set TemplateList {+ - NOT ~}
           52  +  fuzz $TemplateList
           53  +}
           54  +
           55  +# Returns a string containing an SQL binary operator (e.g. "*" or "/").
           56  +#
           57  +proc BinaryOp {} {
           58  +  set TemplateList {
           59  +    || * / % + - << >> & | < <= > >= = == != <> AND OR
           60  +    LIKE GLOB {NOT LIKE}
           61  +  }
           62  +  fuzz $TemplateList
           63  +}
           64  +
           65  +# Return the complete text of an SQL expression.
           66  +#
           67  +set ::ExprDepth 0
           68  +proc Expr { {c {}} } {
           69  +  incr ::ExprDepth
           70  +
           71  +  set TemplateList [concat $c $c $c {[Literal]}]
           72  +  if {$::ExprDepth < 3} {
           73  +    lappend TemplateList \
           74  +      {[Expr $c] [BinaryOp] [Expr $c]}                              \
           75  +      {[UnaryOp] [Expr $c]}                                         \
           76  +      {[Expr $c] ISNULL}                                            \
           77  +      {[Expr $c] NOTNULL}                                           \
           78  +      {CAST([Expr $c] AS blob)}                                     \
           79  +      {CAST([Expr $c] AS text)}                                     \
           80  +      {CAST([Expr $c] AS integer)}                                  \
           81  +      {CAST([Expr $c] AS real)}                                     \
           82  +      {abs([Expr])}                                                 \
           83  +      {coalesce([Expr], [Expr])}                                    \
           84  +      {hex([Expr])}                                                 \
           85  +      {length([Expr])}                                              \
           86  +      {lower([Expr])}                                               \
           87  +      {upper([Expr])}                                               \
           88  +      {quote([Expr])}                                               \
           89  +      {random()}                                                    \
           90  +      {randomblob(min(max([Expr],1), 500))}                         \
           91  +      {typeof([Expr])}                                              \
           92  +      {substr([Expr],[Expr],[Expr])}                                \
           93  +      {CASE WHEN [Expr $c] THEN [Expr $c] ELSE [Expr $c] END}       \
           94  +      {[Literal]} {[Literal]} {[Literal]}                           \
           95  +      {[Literal]} {[Literal]} {[Literal]}                           \
           96  +      {[Literal]} {[Literal]} {[Literal]}                           \
           97  +      {[Literal]} {[Literal]} {[Literal]}
           98  +  }
           99  +  if {$::SelectDepth < 4} {
          100  +    lappend TemplateList \
          101  +      {([Select 1])}                       \
          102  +      {[Expr $c] IN ([Select 1])}          \
          103  +      {[Expr $c] NOT IN ([Select 1])}      \
          104  +      {EXISTS ([Select 1])}                \
          105  +  } 
          106  +  set res [fuzz $TemplateList]
          107  +  incr ::ExprDepth -1
          108  +  return $res
          109  +}
          110  +
          111  +# Return a valid table name.
          112  +#
          113  +set ::TableList [list]
          114  +proc Table {} {
          115  +  set TemplateList [concat sqlite_master $::TableList]
          116  +  fuzz $TemplateList
          117  +}
          118  +
          119  +# Return one of:
          120  +#
          121  +#     "SELECT DISTINCT", "SELECT ALL" or "SELECT"
          122  +#
          123  +proc SelectKw {} {
          124  +  set TemplateList {
          125  +    "SELECT DISTINCT"
          126  +    "SELECT ALL"
          127  +    "SELECT"
          128  +  }
          129  +  fuzz $TemplateList
          130  +}
          131  +
          132  +# Return a result set for a SELECT statement.
          133  +#
          134  +proc ResultSet {{nRes 0} {c ""}} {
          135  +  if {$nRes == 0} {
          136  +    set nRes [expr {rand()*2 + 1}]
          137  +  }
          138  +
          139  +  set aRes [list]
          140  +  for {set ii 0} {$ii < $nRes} {incr ii} {
          141  +    lappend aRes [Expr $c]
          142  +  }
          143  +
          144  +  join $aRes ", "
          145  +}
          146  +
          147  +set ::SelectDepth 0
          148  +set ::ColumnList [list]
          149  +proc SimpleSelect {{nRes 0}} {
          150  +
          151  +  set TemplateList {
          152  +      {[SelectKw] [ResultSet $nRes]}
          153  +  }
          154  +
          155  +  # The ::SelectDepth variable contains the number of ancestor SELECT
          156  +  # statements (i.e. for a top level SELECT it is set to 0, for a
          157  +  # sub-select 1, for a sub-select of a sub-select 2 etc.).
          158  +  #
          159  +  # If this is already greater than 3, do not generate a complicated
          160  +  # SELECT statement. This tends to cause parser stack overflow (too
          161  +  # boring to bother with).
          162  +  #
          163  +  if {$::SelectDepth < 4} {
          164  +    lappend TemplateList \
          165  +        {[SelectKw] [ResultSet $nRes $::ColumnList] FROM ([Select])}     \
          166  +        {[SelectKw] [ResultSet $nRes] FROM ([Select])}                   \
          167  +        {[SelectKw] [ResultSet $nRes $::ColumnList] FROM [Table]}        \
          168  +        {
          169  +             [SelectKw] [ResultSet $nRes $::ColumnList] 
          170  +             FROM ([Select]) 
          171  +             GROUP BY [Expr]
          172  +             HAVING [Expr]
          173  +        }                                                                \
          174  +
          175  +    if {0 == $nRes} {
          176  +      lappend TemplateList                                               \
          177  +          {[SelectKw] * FROM ([Select])}                                 \
          178  +          {[SelectKw] * FROM [Table]}                                    \
          179  +          {[SelectKw] * FROM [Table] WHERE [Expr $::ColumnList]}         \
          180  +          {
          181  +             [SelectKw] * 
          182  +             FROM [Table],[Table] AS t2 
          183  +             WHERE [Expr $::ColumnList] 
          184  +          } {
          185  +             [SelectKw] * 
          186  +             FROM [Table] LEFT OUTER JOIN [Table] AS t2 
          187  +             ON [Expr $::ColumnList]
          188  +             WHERE [Expr $::ColumnList] 
          189  +          }
          190  +    }
          191  +  } 
          192  +
          193  +  fuzz $TemplateList
          194  +}
          195  +
          196  +# Return a SELECT statement.
          197  +#
          198  +# If boolean parameter $isExpr is set to true, make sure the
          199  +# returned SELECT statement returns a single column of data.
          200  +#
          201  +proc Select {{nMulti 0}} {
          202  +  set TemplateList {
          203  +    {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
          204  +    {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
          205  +    {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
          206  +    {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
          207  +    {[SimpleSelect $nMulti] ORDER BY [Expr] DESC}
          208  +    {[SimpleSelect $nMulti] ORDER BY [Expr] ASC}
          209  +    {[SimpleSelect $nMulti] ORDER BY [Expr] ASC, [Expr] DESC}
          210  +    {[SimpleSelect $nMulti] ORDER BY [Expr] LIMIT [Expr] OFFSET [Expr]}
          211  +  }
          212  +
          213  +  if {$::SelectDepth < 4} {
          214  +    if {$nMulti == 0} {
          215  +      set nMulti [expr {(rand()*2)+1}]
          216  +    }
          217  +    lappend TemplateList                                             \
          218  +        {[SimpleSelect $nMulti] UNION     [Select $nMulti]}          \
          219  +        {[SimpleSelect $nMulti] UNION ALL [Select $nMulti]}          \
          220  +        {[SimpleSelect $nMulti] EXCEPT    [Select $nMulti]}          \
          221  +        {[SimpleSelect $nMulti] INTERSECT [Select $nMulti]}
          222  +  }
          223  +
          224  +  incr ::SelectDepth
          225  +  set res [fuzz $TemplateList]
          226  +  incr ::SelectDepth -1
          227  +  set res
          228  +}
          229  +
          230  +# Generate and return a fuzzy INSERT statement.
          231  +#
          232  +proc Insert {} {
          233  +  set TemplateList {
          234  +      {INSERT INTO [Table] VALUES([Expr], [Expr], [Expr]);}
          235  +      {INSERT INTO [Table] VALUES([Expr], [Expr], [Expr], [Expr]);}
          236  +      {INSERT INTO [Table] VALUES([Expr], [Expr]);}
          237  +  }
          238  +  fuzz $TemplateList
          239  +}
          240  +
          241  +proc Column {} {
          242  +  fuzz $::ColumnList
          243  +}
          244  +
          245  +# Generate and return a fuzzy UPDATE statement.
          246  +#
          247  +proc Update {} {
          248  +  set TemplateList {
          249  +    {UPDATE [Table] 
          250  +     SET [Column] = [Expr $::ColumnList] 
          251  +     WHERE [Expr $::ColumnList]}
          252  +  }
          253  +  fuzz $TemplateList
          254  +}
          255  +
          256  +proc Delete {} {
          257  +  set TemplateList {
          258  +    {DELETE FROM [Table] WHERE [Expr $::ColumnList]}
          259  +  }
          260  +  fuzz $TemplateList
          261  +}
          262  +
          263  +proc Statement {} {
          264  +  set TemplateList {
          265  +    {[Update]}
          266  +    {[Insert]}
          267  +    {[Select]}
          268  +    {[Delete]}
          269  +  }
          270  +  fuzz $TemplateList
          271  +}
          272  +
          273  +# Return an identifier. This just chooses randomly from a fixed set
          274  +# of strings.
          275  +proc Identifier {} {
          276  +  set TemplateList {
          277  +    This just chooses randomly a fixed 
          278  +    We would also thank the developers 
          279  +    for their analysis Samba
          280  +  }
          281  +  fuzz $TemplateList
          282  +}
          283  +
          284  +proc Check {} {
          285  +  # Use a large value for $::SelectDepth, because sub-selects are
          286  +  # not allowed in expressions used by CHECK constraints.
          287  +  #
          288  +  set sd $::SelectDepth 
          289  +  set ::SelectDepth 500
          290  +  set TemplateList {
          291  +    {}
          292  +    {CHECK ([Expr])}
          293  +  }
          294  +  set res [fuzz $TemplateList]
          295  +  set ::SelectDepth $sd
          296  +  set res
          297  +}
          298  +
          299  +proc Coltype {} {
          300  +  set TemplateList {
          301  +    {INTEGER PRIMARY KEY}
          302  +    {VARCHAR [Check]}
          303  +    {PRIMARY KEY}
          304  +  }
          305  +  fuzz $TemplateList
          306  +}
          307  +
          308  +proc DropTable {} {
          309  +  set TemplateList {
          310  +    {DROP TABLE IF EXISTS [Identifier]}
          311  +  }
          312  +  fuzz $TemplateList
          313  +}
          314  +
          315  +proc CreateView {} {
          316  +  set TemplateList {
          317  +    {CREATE VIEW [Identifier] AS [Select]}
          318  +  }
          319  +  fuzz $TemplateList
          320  +}
          321  +proc DropView {} {
          322  +  set TemplateList {
          323  +    {DROP VIEW IF EXISTS [Identifier]}
          324  +  }
          325  +  fuzz $TemplateList
          326  +}
          327  +
          328  +proc CreateTable {} {
          329  +  set TemplateList {
          330  +    {CREATE TABLE [Identifier]([Identifier] [Coltype], [Identifier] [Coltype])}
          331  +    {CREATE TEMP TABLE [Identifier]([Identifier] [Coltype])}
          332  +  }
          333  +  fuzz $TemplateList
          334  +}
          335  +
          336  +proc CreateOrDropTableOrView {} {
          337  +  set TemplateList {
          338  +    {[CreateTable]}
          339  +    {[DropTable]}
          340  +    {[CreateView]}
          341  +    {[DropView]}
          342  +  }
          343  +  fuzz $TemplateList
          344  +}
          345  +
          346  +########################################################################
          347  +
          348  +set ::log [open fuzzy.log w]
          349  +
          350  +#
          351  +# Usage: do_fuzzy_test <testname> ?<options>?
          352  +# 
          353  +#     -template
          354  +#     -errorlist
          355  +#     -repeats
          356  +#     
          357  +proc do_fuzzy_test {testname args} {
          358  +  set ::fuzzyopts(-errorlist) [list]
          359  +  set ::fuzzyopts(-repeats) $::REPEATS
          360  +  array set ::fuzzyopts $args
          361  +
          362  +  lappend ::fuzzyopts(-errorlist) {parser stack overflow} 
          363  +  lappend ::fuzzyopts(-errorlist) {ORDER BY}
          364  +  lappend ::fuzzyopts(-errorlist) {GROUP BY}
          365  +  lappend ::fuzzyopts(-errorlist) {datatype mismatch}
          366  +
          367  +  for {set ii 0} {$ii < $::fuzzyopts(-repeats)} {incr ii} {
          368  +    do_test ${testname}.$ii {
          369  +      set ::sql [subst $::fuzzyopts(-template)]
          370  +      puts $::log $::sql
          371  +      flush $::log
          372  +      set rc [catch {execsql $::sql} msg]
          373  +      set e 1
          374  +      if {$rc} {
          375  +        set e 0
          376  +        foreach error $::fuzzyopts(-errorlist) {
          377  +          if {0 == [string first $error $msg]} {
          378  +            set e 1
          379  +            break
          380  +          }
          381  +        }
          382  +      }
          383  +      if {$e == 0} {
          384  +        puts ""
          385  +        puts $::sql
          386  +        puts $msg
          387  +      }
          388  +      set e
          389  +    } {1}
          390  +  }
          391  +}
          392  +

Added test/fuzz_malloc.test.

            1  +#
            2  +# 2007 May 10
            3  +#
            4  +# The author disclaims copyright to this source code.  In place of
            5  +# a legal notice, here is a blessing:
            6  +#
            7  +#    May you do good and not evil.
            8  +#    May you find forgiveness for yourself and forgive others.
            9  +#    May you share freely, never taking more than you give.
           10  +#
           11  +#***********************************************************************
           12  +#
           13  +# This file tests malloc failures in concert with fuzzy SQL generation.
           14  +#
           15  +# $Id: fuzz_malloc.test,v 1.1 2007/05/30 10:36:47 danielk1977 Exp $
           16  +
           17  +set testdir [file dirname $argv0]
           18  +source $testdir/tester.tcl
           19  +source $testdir/fuzz_common.tcl
           20  +source $testdir/malloc_common.tcl
           21  +
           22  +set ::REPEATS 20
           23  +
           24  +#
           25  +# Usage: do_fuzzy_malloc_test <testname> ?<options>?
           26  +# 
           27  +#     -template
           28  +#     -repeats
           29  +#     
           30  +proc do_fuzzy_malloc_test {testname args} {
           31  +  set ::fuzzyopts(-repeats) $::REPEATS
           32  +  array set ::fuzzyopts $args
           33  +
           34  +  for {set ii 0} {$ii < $::fuzzyopts(-repeats)} {incr ii} {
           35  +    set ::sql [subst $::fuzzyopts(-template)]
           36  +    # puts $::sql
           37  +    foreach {rc res} [catchsql $::sql] {}
           38  +    if {$rc==0} {
           39  +      do_malloc_test $testname-$ii -sqlbody $::sql
           40  +    } else {
           41  +      incr ii -1
           42  +    }
           43  +  }
           44  +}
           45  +
           46  +#----------------------------------------------------------------
           47  +# Test malloc failure during parsing (and execution) of a fuzzily 
           48  +# generated expressions.
           49  +#
           50  +do_fuzzy_malloc_test fuzzy_malloc-1 -template {Select [Expr]}
           51  +
           52  +sqlite_malloc_fail 0
           53  +finish_test

Changes to test/malloc.test.

    10     10   #***********************************************************************
    11     11   # This file attempts to check the library in an out-of-memory situation.
    12     12   # When compiled with -DSQLITE_DEBUG=1, the SQLite library accepts a special
    13     13   # command (sqlite_malloc_fail N) which causes the N-th malloc to fail.  This
    14     14   # special feature is used to see what happens in the library if a malloc
    15     15   # were to really fail due to an out-of-memory situation.
    16     16   #
    17         -# $Id: malloc.test,v 1.41 2007/04/19 11:09:02 danielk1977 Exp $
           17  +# $Id: malloc.test,v 1.42 2007/05/30 10:36:47 danielk1977 Exp $
    18     18   
    19     19   set testdir [file dirname $argv0]
    20     20   source $testdir/tester.tcl
    21     21   
    22     22   # Only run these tests if memory debugging is turned on.
    23     23   #
    24     24   if {[info command sqlite_malloc_stat]==""} {
    25     25      puts "Skipping malloc tests: not compiled with -DSQLITE_MEMDEBUG..."
    26     26      finish_test
    27     27      return
    28     28   }
    29     29   
    30         -# Usage: do_malloc_test <test number> <options...>
    31         -#
    32         -# The first argument, <test number>, is an integer used to name the
    33         -# tests executed by this proc. Options are as follows:
    34         -#
    35         -#     -tclprep          TCL script to run to prepare test.
    36         -#     -sqlprep          SQL script to run to prepare test.
    37         -#     -tclbody          TCL script to run with malloc failure simulation.
    38         -#     -sqlbody          TCL script to run with malloc failure simulation.
    39         -#     -cleanup          TCL script to run after the test.
    40         -#
    41         -# This command runs a series of tests to verify SQLite's ability
    42         -# to handle an out-of-memory condition gracefully. It is assumed
    43         -# that if this condition occurs a malloc() call will return a
    44         -# NULL pointer. Linux, for example, doesn't do that by default. See
    45         -# the "BUGS" section of malloc(3).
    46         -#
    47         -# Each iteration of a loop, the TCL commands in any argument passed
    48         -# to the -tclbody switch, followed by the SQL commands in any argument
    49         -# passed to the -sqlbody switch are executed. Each iteration the
    50         -# Nth call to sqliteMalloc() is made to fail, where N is increased
    51         -# each time the loop runs starting from 1. When all commands execute
    52         -# successfully, the loop ends.
    53         -#
    54         -proc do_malloc_test {tn args} {
    55         -  array unset ::mallocopts 
    56         -  array set ::mallocopts $args
    57         -
    58         -  set ::go 1
    59         -  for {set ::n 1} {$::go && $::n < 50000} {incr ::n} {
    60         -    do_test malloc-$tn.$::n {
    61         -
    62         -      # Remove all traces of database files test.db and test2.db from the files
    63         -      # system. Then open (empty database) "test.db" with the handle [db].
    64         -      # 
    65         -      sqlite_malloc_fail 0
    66         -      catch {db close} 
    67         -      catch {file delete -force test.db}
    68         -      catch {file delete -force test.db-journal}
    69         -      catch {file delete -force test2.db}
    70         -      catch {file delete -force test2.db-journal}
    71         -      catch {sqlite3 db test.db} 
    72         -      set ::DB [sqlite3_connection_pointer db]
    73         -
    74         -      # Execute any -tclprep and -sqlprep scripts.
    75         -      #
    76         -      if {[info exists ::mallocopts(-tclprep)]} {
    77         -        eval $::mallocopts(-tclprep)
    78         -      }
    79         -      if {[info exists ::mallocopts(-sqlprep)]} {
    80         -        execsql $::mallocopts(-sqlprep)
    81         -      }
    82         -
    83         -      # Now set the ${::n}th malloc() to fail and execute the -tclbody and
    84         -      # -sqlbody scripts.
    85         -      #
    86         -      sqlite_malloc_fail $::n
    87         -      set ::mallocbody {}
    88         -      if {[info exists ::mallocopts(-tclbody)]} {
    89         -        append ::mallocbody "$::mallocopts(-tclbody)\n"
    90         -      }
    91         -      if {[info exists ::mallocopts(-sqlbody)]} {
    92         -        append ::mallocbody "db eval {$::mallocopts(-sqlbody)}"
    93         -      }
    94         -      set v [catch $::mallocbody msg]
    95         -
    96         -      # If the test fails (if $v!=0) and the database connection actually
    97         -      # exists, make sure the failure code is SQLITE_NOMEM.
    98         -      if {$v && [info command db]=="db" && [info exists ::mallocopts(-sqlbody)]
    99         -              && [db errorcode]!=7} {
   100         -        set v 999
   101         -      }
   102         -
   103         -      set leftover [lindex [sqlite_malloc_stat] 2]
   104         -      if {$leftover>0} {
   105         -        if {$leftover>1} {puts "\nLeftover: $leftover\nReturn=$v  Message=$msg"}
   106         -        set ::go 0
   107         -        if {$v} {
   108         -          puts "\nError message returned: $msg"
   109         -        } else {
   110         -          set v {1 1}
   111         -        }
   112         -      } else {
   113         -        set v2 [expr {$msg=="" || $msg=="out of memory"}]
   114         -        if {!$v2} {puts "\nError message returned: $msg"}
   115         -        lappend v $v2
   116         -      }
   117         -    } {1 1}
   118         -
   119         -    if {[info exists ::mallocopts(-cleanup)]} {
   120         -      catch [list uplevel #0 $::mallocopts(-cleanup)] msg
   121         -    }
   122         -  }
   123         -  unset ::mallocopts
   124         -}
           30  +source $testdir/malloc_common.tcl
   125     31   
   126     32   do_malloc_test 1 -tclprep {
   127     33     db close
   128     34   } -tclbody {
   129     35     if {[catch {sqlite3 db test.db}]} {
   130     36       error "out of memory"
   131     37     }

Added test/mallocB.test.

            1  +# 2007 May 30
            2  +#
            3  +# The author disclaims copyright to this source code.  In place of
            4  +# a legal notice, here is a blessing:
            5  +#
            6  +#    May you do good and not evil.
            7  +#    May you find forgiveness for yourself and forgive others.
            8  +#    May you share freely, never taking more than you give.
            9  +#
           10  +#***********************************************************************
           11  +# This file contains additional out-of-memory checks (see malloc.tcl).
           12  +# These were all discovered by fuzzy generation of SQL. Apart from
           13  +# that they have little in common.
           14  +#
           15  +# $Id: mallocB.test,v 1.1 2007/05/30 10:36:47 danielk1977 Exp $
           16  +
           17  +set testdir [file dirname $argv0]
           18  +source $testdir/tester.tcl
           19  +source $testdir/malloc_common.tcl
           20  +
           21  +# Only run these tests if memory debugging is turned on.
           22  +#
           23  +if {[info command sqlite_malloc_stat]==""} {
           24  +   puts "Skipping malloc tests: not compiled with -DSQLITE_MEMDEBUG..."
           25  +   finish_test
           26  +   return
           27  +}
           28  +
           29  +do_malloc_test mallocB-1 -sqlbody {SELECT - 456}
           30  +do_malloc_test mallocB-2 -sqlbody {SELECT - 456.1}
           31  +do_malloc_test mallocB-3 -sqlbody {SELECT random()}
           32  +do_malloc_test mallocB-4 -sqlbody {SELECT zeroblob(1000)}
           33  +
           34  +sqlite_malloc_fail 0
           35  +finish_test

Added test/malloc_common.tcl.

            1  +
            2  +# Usage: do_malloc_test <test number> <options...>
            3  +#
            4  +# The first argument, <test number>, is an integer used to name the
            5  +# tests executed by this proc. Options are as follows:
            6  +#
            7  +#     -tclprep          TCL script to run to prepare test.
            8  +#     -sqlprep          SQL script to run to prepare test.
            9  +#     -tclbody          TCL script to run with malloc failure simulation.
           10  +#     -sqlbody          TCL script to run with malloc failure simulation.
           11  +#     -cleanup          TCL script to run after the test.
           12  +#
           13  +# This command runs a series of tests to verify SQLite's ability
           14  +# to handle an out-of-memory condition gracefully. It is assumed
           15  +# that if this condition occurs a malloc() call will return a
           16  +# NULL pointer. Linux, for example, doesn't do that by default. See
           17  +# the "BUGS" section of malloc(3).
           18  +#
           19  +# Each iteration of a loop, the TCL commands in any argument passed
           20  +# to the -tclbody switch, followed by the SQL commands in any argument
           21  +# passed to the -sqlbody switch are executed. Each iteration the
           22  +# Nth call to sqliteMalloc() is made to fail, where N is increased
           23  +# each time the loop runs starting from 1. When all commands execute
           24  +# successfully, the loop ends.
           25  +#
           26  +proc do_malloc_test {tn args} {
           27  +  array unset ::mallocopts 
           28  +  array set ::mallocopts $args
           29  +
           30  +  if {[string is integer $tn]} {
           31  +    set tn malloc-$tn
           32  +  }
           33  +
           34  +  set ::go 1
           35  +  for {set ::n 1} {$::go && $::n < 50000} {incr ::n} {
           36  +    do_test $tn.$::n {
           37  +
           38  +      # Remove all traces of database files test.db and test2.db from the files
           39  +      # system. Then open (empty database) "test.db" with the handle [db].
           40  +      # 
           41  +      sqlite_malloc_fail 0
           42  +      catch {db close} 
           43  +      catch {file delete -force test.db}
           44  +      catch {file delete -force test.db-journal}
           45  +      catch {file delete -force test2.db}
           46  +      catch {file delete -force test2.db-journal}
           47  +      catch {sqlite3 db test.db} 
           48  +      set ::DB [sqlite3_connection_pointer db]
           49  +
           50  +      # Execute any -tclprep and -sqlprep scripts.
           51  +      #
           52  +      if {[info exists ::mallocopts(-tclprep)]} {
           53  +        eval $::mallocopts(-tclprep)
           54  +      }
           55  +      if {[info exists ::mallocopts(-sqlprep)]} {
           56  +        execsql $::mallocopts(-sqlprep)
           57  +      }
           58  +
           59  +      # Now set the ${::n}th malloc() to fail and execute the -tclbody and
           60  +      # -sqlbody scripts.
           61  +      #
           62  +      sqlite_malloc_fail $::n
           63  +      set ::mallocbody {}
           64  +      if {[info exists ::mallocopts(-tclbody)]} {
           65  +        append ::mallocbody "$::mallocopts(-tclbody)\n"
           66  +      }
           67  +      if {[info exists ::mallocopts(-sqlbody)]} {
           68  +        append ::mallocbody "db eval {$::mallocopts(-sqlbody)}"
           69  +      }
           70  +      set v [catch $::mallocbody msg]
           71  +
           72  +      # If the test fails (if $v!=0) and the database connection actually
           73  +      # exists, make sure the failure code is SQLITE_NOMEM.
           74  +      if {$v && [info command db]=="db" && [info exists ::mallocopts(-sqlbody)]
           75  +              && [db errorcode]!=7} {
           76  +        set v 999
           77  +      }
           78  +
           79  +      set leftover [lindex [sqlite_malloc_stat] 2]
           80  +      if {$leftover>0} {
           81  +        if {$leftover>1} {puts "\nLeftover: $leftover\nReturn=$v  Message=$msg"}
           82  +        set ::go 0
           83  +        if {$v} {
           84  +          puts "\nError message returned: $msg"
           85  +        } else {
           86  +          set v {1 1}
           87  +        }
           88  +      } else {
           89  +        set v2 [expr {$msg=="" || $msg=="out of memory"}]
           90  +        if {!$v2} {puts "\nError message returned: $msg"}
           91  +        lappend v $v2
           92  +      }
           93  +    } {1 1}
           94  +
           95  +    if {[info exists ::mallocopts(-cleanup)]} {
           96  +      catch [list uplevel #0 $::mallocopts(-cleanup)] msg
           97  +    }
           98  +  }
           99  +  unset ::mallocopts
          100  +}
          101  +

Changes to test/quick.test.

     2      2   #    May you do good and not evil.
     3      3   #    May you find forgiveness for yourself and forgive others.
     4      4   #    May you share freely, never taking more than you give.
     5      5   #
     6      6   #***********************************************************************
     7      7   # This file runs all tests.
     8      8   #
     9         -# $Id: quick.test,v 1.57 2007/05/30 08:18:04 danielk1977 Exp $
            9  +# $Id: quick.test,v 1.58 2007/05/30 10:36:47 danielk1977 Exp $
    10     10   
    11     11   proc lshift {lvar} {
    12     12     upvar $lvar l
    13     13     set ret [lindex $l 0]
    14     14     set l [lrange $l 1 end]
    15     15     return $ret
    16     16   }
................................................................................
    42     42     btree5.test
    43     43     btree6.test
    44     44     corrupt.test
    45     45     crash.test
    46     46     crash2.test
    47     47     exclusive3.test
    48     48     fuzz.test
           49  +  fuzz_malloc.test
    49     50     in2.test
    50     51     loadext.test
    51     52     malloc.test
    52     53     malloc2.test
    53     54     malloc3.test
    54     55     memleak.test
    55     56     misc7.test

Changes to test/soak.test.

     7      7   #    May you find forgiveness for yourself and forgive others.
     8      8   #    May you share freely, never taking more than you give.
     9      9   #
    10     10   #***********************************************************************
    11     11   # This file is the driver for the "soak" tests. It is a peer of the
    12     12   # quick.test and all.test scripts.
    13     13   #
    14         -# $Id: soak.test,v 1.1 2007/05/30 08:18:04 danielk1977 Exp $
           14  +# $Id: soak.test,v 1.2 2007/05/30 10:36:47 danielk1977 Exp $
    15     15   
    16     16   set testdir [file dirname $argv0]
    17     17   source $testdir/tester.tcl
    18     18   rename finish_test really_finish_test
    19     19   proc finish_test {} {}
    20     20   
    21     21   # By default, guarantee that the tests will run for at least 1 hour.
................................................................................
    56     56   # Storing checksums etc.
    57     57   #
    58     58   
    59     59   # List of test files that are run by this file.
    60     60   #
    61     61   set SOAKTESTS {
    62     62     fuzz.test
           63  +  fuzz_malloc.test
    63     64     trans.test
    64     65   }
    65     66   
    66     67   set ISQUICK 1
    67     68   
    68     69   set soak_starttime  [clock seconds]
    69     70   set soak_finishtime [expr {$soak_starttime + $TIMEOUT}]