persistentstorage/sqlite3api/TEST/TclScript/fuzz_common.tcl
changeset 0 08ec8eefde2f
equal deleted inserted replaced
-1:000000000000 0:08ec8eefde2f
       
     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