sl@0: # 2007 May 10
sl@0: #
sl@0: # The author disclaims copyright to this source code.  In place of
sl@0: # a legal notice, here is a blessing:
sl@0: #
sl@0: #    May you do good and not evil.
sl@0: #    May you find forgiveness for yourself and forgive others.
sl@0: #    May you share freely, never taking more than you give.
sl@0: #
sl@0: #***********************************************************************
sl@0: #
sl@0: # $Id: fuzz_common.tcl,v 1.1 2007/05/30 10:36:47 danielk1977 Exp $
sl@0: 
sl@0: proc fuzz {TemplateList} {
sl@0:   set n [llength $TemplateList]
sl@0:   set i [expr {int(rand()*$n)}]
sl@0:   set r [uplevel 1 subst -novar [list [lindex $TemplateList $i]]]
sl@0: 
sl@0:   string map {"\n" " "} $r
sl@0: }
sl@0: 
sl@0: # Fuzzy generation primitives:
sl@0: #
sl@0: #     Literal
sl@0: #     UnaryOp
sl@0: #     BinaryOp
sl@0: #     Expr
sl@0: #     Table
sl@0: #     Select
sl@0: #     Insert
sl@0: #
sl@0: 
sl@0: # Returns a string representing an SQL literal.
sl@0: #
sl@0: proc Literal {} {
sl@0:   set TemplateList {
sl@0:     456 0 -456 1 -1 
sl@0:     2147483648 2147483647 2147483649 -2147483647 -2147483648 -2147483649
sl@0:     'The' 'first' 'experiments' 'in' 'hardware' 'fault' 'injection'
sl@0:     zeroblob(1000)
sl@0:     NULL
sl@0:     56.1 -56.1
sl@0:     123456789.1234567899
sl@0:   }
sl@0:   fuzz $TemplateList
sl@0: }
sl@0: 
sl@0: # Returns a string containing an SQL unary operator (e.g. "+" or "NOT").
sl@0: #
sl@0: proc UnaryOp {} {
sl@0:   set TemplateList {+ - NOT ~}
sl@0:   fuzz $TemplateList
sl@0: }
sl@0: 
sl@0: # Returns a string containing an SQL binary operator (e.g. "*" or "/").
sl@0: #
sl@0: proc BinaryOp {} {
sl@0:   set TemplateList {
sl@0:     || * / % + - << >> & | < <= > >= = == != <> AND OR
sl@0:     LIKE GLOB {NOT LIKE}
sl@0:   }
sl@0:   fuzz $TemplateList
sl@0: }
sl@0: 
sl@0: # Return the complete text of an SQL expression.
sl@0: #
sl@0: set ::ExprDepth 0
sl@0: proc Expr { {c {}} } {
sl@0:   incr ::ExprDepth
sl@0: 
sl@0:   set TemplateList [concat $c $c $c {[Literal]}]
sl@0:   if {$::ExprDepth < 3} {
sl@0:     lappend TemplateList \
sl@0:       {[Expr $c] [BinaryOp] [Expr $c]}                              \
sl@0:       {[UnaryOp] [Expr $c]}                                         \
sl@0:       {[Expr $c] ISNULL}                                            \
sl@0:       {[Expr $c] NOTNULL}                                           \
sl@0:       {CAST([Expr $c] AS blob)}                                     \
sl@0:       {CAST([Expr $c] AS text)}                                     \
sl@0:       {CAST([Expr $c] AS integer)}                                  \
sl@0:       {CAST([Expr $c] AS real)}                                     \
sl@0:       {abs([Expr])}                                                 \
sl@0:       {coalesce([Expr], [Expr])}                                    \
sl@0:       {hex([Expr])}                                                 \
sl@0:       {length([Expr])}                                              \
sl@0:       {lower([Expr])}                                               \
sl@0:       {upper([Expr])}                                               \
sl@0:       {quote([Expr])}                                               \
sl@0:       {random()}                                                    \
sl@0:       {randomblob(min(max([Expr],1), 500))}                         \
sl@0:       {typeof([Expr])}                                              \
sl@0:       {substr([Expr],[Expr],[Expr])}                                \
sl@0:       {CASE WHEN [Expr $c] THEN [Expr $c] ELSE [Expr $c] END}       \
sl@0:       {[Literal]} {[Literal]} {[Literal]}                           \
sl@0:       {[Literal]} {[Literal]} {[Literal]}                           \
sl@0:       {[Literal]} {[Literal]} {[Literal]}                           \
sl@0:       {[Literal]} {[Literal]} {[Literal]}
sl@0:   }
sl@0:   if {$::SelectDepth < 4} {
sl@0:     lappend TemplateList \
sl@0:       {([Select 1])}                       \
sl@0:       {[Expr $c] IN ([Select 1])}          \
sl@0:       {[Expr $c] NOT IN ([Select 1])}      \
sl@0:       {EXISTS ([Select 1])}                \
sl@0:   } 
sl@0:   set res [fuzz $TemplateList]
sl@0:   incr ::ExprDepth -1
sl@0:   return $res
sl@0: }
sl@0: 
sl@0: # Return a valid table name.
sl@0: #
sl@0: set ::TableList [list]
sl@0: proc Table {} {
sl@0:   set TemplateList [concat sqlite_master $::TableList]
sl@0:   fuzz $TemplateList
sl@0: }
sl@0: 
sl@0: # Return one of:
sl@0: #
sl@0: #     "SELECT DISTINCT", "SELECT ALL" or "SELECT"
sl@0: #
sl@0: proc SelectKw {} {
sl@0:   set TemplateList {
sl@0:     "SELECT DISTINCT"
sl@0:     "SELECT ALL"
sl@0:     "SELECT"
sl@0:   }
sl@0:   fuzz $TemplateList
sl@0: }
sl@0: 
sl@0: # Return a result set for a SELECT statement.
sl@0: #
sl@0: proc ResultSet {{nRes 0} {c ""}} {
sl@0:   if {$nRes == 0} {
sl@0:     set nRes [expr {rand()*2 + 1}]
sl@0:   }
sl@0: 
sl@0:   set aRes [list]
sl@0:   for {set ii 0} {$ii < $nRes} {incr ii} {
sl@0:     lappend aRes [Expr $c]
sl@0:   }
sl@0: 
sl@0:   join $aRes ", "
sl@0: }
sl@0: 
sl@0: set ::SelectDepth 0
sl@0: set ::ColumnList [list]
sl@0: proc SimpleSelect {{nRes 0}} {
sl@0: 
sl@0:   set TemplateList {
sl@0:       {[SelectKw] [ResultSet $nRes]}
sl@0:   }
sl@0: 
sl@0:   # The ::SelectDepth variable contains the number of ancestor SELECT
sl@0:   # statements (i.e. for a top level SELECT it is set to 0, for a
sl@0:   # sub-select 1, for a sub-select of a sub-select 2 etc.).
sl@0:   #
sl@0:   # If this is already greater than 3, do not generate a complicated
sl@0:   # SELECT statement. This tends to cause parser stack overflow (too
sl@0:   # boring to bother with).
sl@0:   #
sl@0:   if {$::SelectDepth < 4} {
sl@0:     lappend TemplateList \
sl@0:         {[SelectKw] [ResultSet $nRes $::ColumnList] FROM ([Select])}     \
sl@0:         {[SelectKw] [ResultSet $nRes] FROM ([Select])}                   \
sl@0:         {[SelectKw] [ResultSet $nRes $::ColumnList] FROM [Table]}        \
sl@0:         {
sl@0:              [SelectKw] [ResultSet $nRes $::ColumnList] 
sl@0:              FROM ([Select]) 
sl@0:              GROUP BY [Expr]
sl@0:              HAVING [Expr]
sl@0:         }                                                                \
sl@0: 
sl@0:     if {0 == $nRes} {
sl@0:       lappend TemplateList                                               \
sl@0:           {[SelectKw] * FROM ([Select])}                                 \
sl@0:           {[SelectKw] * FROM [Table]}                                    \
sl@0:           {[SelectKw] * FROM [Table] WHERE [Expr $::ColumnList]}         \
sl@0:           {
sl@0:              [SelectKw] * 
sl@0:              FROM [Table],[Table] AS t2 
sl@0:              WHERE [Expr $::ColumnList] 
sl@0:           } {
sl@0:              [SelectKw] * 
sl@0:              FROM [Table] LEFT OUTER JOIN [Table] AS t2 
sl@0:              ON [Expr $::ColumnList]
sl@0:              WHERE [Expr $::ColumnList] 
sl@0:           }
sl@0:     }
sl@0:   } 
sl@0: 
sl@0:   fuzz $TemplateList
sl@0: }
sl@0: 
sl@0: # Return a SELECT statement.
sl@0: #
sl@0: # If boolean parameter $isExpr is set to true, make sure the
sl@0: # returned SELECT statement returns a single column of data.
sl@0: #
sl@0: proc Select {{nMulti 0}} {
sl@0:   set TemplateList {
sl@0:     {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
sl@0:     {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
sl@0:     {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
sl@0:     {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
sl@0:     {[SimpleSelect $nMulti] ORDER BY [Expr] DESC}
sl@0:     {[SimpleSelect $nMulti] ORDER BY [Expr] ASC}
sl@0:     {[SimpleSelect $nMulti] ORDER BY [Expr] ASC, [Expr] DESC}
sl@0:     {[SimpleSelect $nMulti] ORDER BY [Expr] LIMIT [Expr] OFFSET [Expr]}
sl@0:   }
sl@0: 
sl@0:   if {$::SelectDepth < 4} {
sl@0:     if {$nMulti == 0} {
sl@0:       set nMulti [expr {(rand()*2)+1}]
sl@0:     }
sl@0:     lappend TemplateList                                             \
sl@0:         {[SimpleSelect $nMulti] UNION     [Select $nMulti]}          \
sl@0:         {[SimpleSelect $nMulti] UNION ALL [Select $nMulti]}          \
sl@0:         {[SimpleSelect $nMulti] EXCEPT    [Select $nMulti]}          \
sl@0:         {[SimpleSelect $nMulti] INTERSECT [Select $nMulti]}
sl@0:   }
sl@0: 
sl@0:   incr ::SelectDepth
sl@0:   set res [fuzz $TemplateList]
sl@0:   incr ::SelectDepth -1
sl@0:   set res
sl@0: }
sl@0: 
sl@0: # Generate and return a fuzzy INSERT statement.
sl@0: #
sl@0: proc Insert {} {
sl@0:   set TemplateList {
sl@0:       {INSERT INTO [Table] VALUES([Expr], [Expr], [Expr]);}
sl@0:       {INSERT INTO [Table] VALUES([Expr], [Expr], [Expr], [Expr]);}
sl@0:       {INSERT INTO [Table] VALUES([Expr], [Expr]);}
sl@0:   }
sl@0:   fuzz $TemplateList
sl@0: }
sl@0: 
sl@0: proc Column {} {
sl@0:   fuzz $::ColumnList
sl@0: }
sl@0: 
sl@0: # Generate and return a fuzzy UPDATE statement.
sl@0: #
sl@0: proc Update {} {
sl@0:   set TemplateList {
sl@0:     {UPDATE [Table] 
sl@0:      SET [Column] = [Expr $::ColumnList] 
sl@0:      WHERE [Expr $::ColumnList]}
sl@0:   }
sl@0:   fuzz $TemplateList
sl@0: }
sl@0: 
sl@0: proc Delete {} {
sl@0:   set TemplateList {
sl@0:     {DELETE FROM [Table] WHERE [Expr $::ColumnList]}
sl@0:   }
sl@0:   fuzz $TemplateList
sl@0: }
sl@0: 
sl@0: proc Statement {} {
sl@0:   set TemplateList {
sl@0:     {[Update]}
sl@0:     {[Insert]}
sl@0:     {[Select]}
sl@0:     {[Delete]}
sl@0:   }
sl@0:   fuzz $TemplateList
sl@0: }
sl@0: 
sl@0: # Return an identifier. This just chooses randomly from a fixed set
sl@0: # of strings.
sl@0: proc Identifier {} {
sl@0:   set TemplateList {
sl@0:     This just chooses randomly a fixed 
sl@0:     We would also thank the developers 
sl@0:     for their analysis Samba
sl@0:   }
sl@0:   fuzz $TemplateList
sl@0: }
sl@0: 
sl@0: proc Check {} {
sl@0:   # Use a large value for $::SelectDepth, because sub-selects are
sl@0:   # not allowed in expressions used by CHECK constraints.
sl@0:   #
sl@0:   set sd $::SelectDepth 
sl@0:   set ::SelectDepth 500
sl@0:   set TemplateList {
sl@0:     {}
sl@0:     {CHECK ([Expr])}
sl@0:   }
sl@0:   set res [fuzz $TemplateList]
sl@0:   set ::SelectDepth $sd
sl@0:   set res
sl@0: }
sl@0: 
sl@0: proc Coltype {} {
sl@0:   set TemplateList {
sl@0:     {INTEGER PRIMARY KEY}
sl@0:     {VARCHAR [Check]}
sl@0:     {PRIMARY KEY}
sl@0:   }
sl@0:   fuzz $TemplateList
sl@0: }
sl@0: 
sl@0: proc DropTable {} {
sl@0:   set TemplateList {
sl@0:     {DROP TABLE IF EXISTS [Identifier]}
sl@0:   }
sl@0:   fuzz $TemplateList
sl@0: }
sl@0: 
sl@0: proc CreateView {} {
sl@0:   set TemplateList {
sl@0:     {CREATE VIEW [Identifier] AS [Select]}
sl@0:   }
sl@0:   fuzz $TemplateList
sl@0: }
sl@0: proc DropView {} {
sl@0:   set TemplateList {
sl@0:     {DROP VIEW IF EXISTS [Identifier]}
sl@0:   }
sl@0:   fuzz $TemplateList
sl@0: }
sl@0: 
sl@0: proc CreateTable {} {
sl@0:   set TemplateList {
sl@0:     {CREATE TABLE [Identifier]([Identifier] [Coltype], [Identifier] [Coltype])}
sl@0:     {CREATE TEMP TABLE [Identifier]([Identifier] [Coltype])}
sl@0:   }
sl@0:   fuzz $TemplateList
sl@0: }
sl@0: 
sl@0: proc CreateOrDropTableOrView {} {
sl@0:   set TemplateList {
sl@0:     {[CreateTable]}
sl@0:     {[DropTable]}
sl@0:     {[CreateView]}
sl@0:     {[DropView]}
sl@0:   }
sl@0:   fuzz $TemplateList
sl@0: }
sl@0: 
sl@0: ########################################################################
sl@0: 
sl@0: set ::log [open fuzzy.log w]
sl@0: 
sl@0: #
sl@0: # Usage: do_fuzzy_test <testname> ?<options>?
sl@0: # 
sl@0: #     -template
sl@0: #     -errorlist
sl@0: #     -repeats
sl@0: #     
sl@0: proc do_fuzzy_test {testname args} {
sl@0:   set ::fuzzyopts(-errorlist) [list]
sl@0:   set ::fuzzyopts(-repeats) $::REPEATS
sl@0:   array set ::fuzzyopts $args
sl@0: 
sl@0:   lappend ::fuzzyopts(-errorlist) {parser stack overflow} 
sl@0:   lappend ::fuzzyopts(-errorlist) {ORDER BY}
sl@0:   lappend ::fuzzyopts(-errorlist) {GROUP BY}
sl@0:   lappend ::fuzzyopts(-errorlist) {datatype mismatch}
sl@0: 
sl@0:   for {set ii 0} {$ii < $::fuzzyopts(-repeats)} {incr ii} {
sl@0:     do_test ${testname}.$ii {
sl@0:       set ::sql [subst $::fuzzyopts(-template)]
sl@0:       puts $::log $::sql
sl@0:       flush $::log
sl@0:       set rc [catch {execsql $::sql} msg]
sl@0:       set e 1
sl@0:       if {$rc} {
sl@0:         set e 0
sl@0:         foreach error $::fuzzyopts(-errorlist) {
sl@0:           if {0 == [string first $error $msg]} {
sl@0:             set e 1
sl@0:             break
sl@0:           }
sl@0:         }
sl@0:       }
sl@0:       if {$e == 0} {
sl@0:         puts ""
sl@0:         puts $::sql
sl@0:         puts $msg
sl@0:       }
sl@0:       set e
sl@0:     } {1}
sl@0:   }
sl@0: }
sl@0: