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.2 2009/01/05 19:36:30 drh 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   lappend ::fuzzyopts(-errorlist) {non-deterministic functions prohibited}
 367
 368   for {set ii 0} {$ii < $::fuzzyopts(-repeats)} {incr ii} {
 369     do_test ${testname}.$ii {
 370       set ::sql [subst $::fuzzyopts(-template)]
 371       puts $::log $::sql
 372       flush $::log
 373       set rc [catch {execsql $::sql} msg]
 374       set e 1
 375       if {$rc} {
 376         set e 0
 377         foreach error $::fuzzyopts(-errorlist) {
 378           if {[string first $error $msg]>=0} {
 379             set e 1
 380             break
 381           }
 382         }
 383       }
 384       if {$e == 0} {
 385         puts ""
 386         puts $::sql
 387         puts $msg
 388       }
 389       set e
 390     } {1}
 391   }
 392 }