os/persistentdata/persistentstorage/sqlite3api/TEST/TclScript/fuzz_common.tcl
changeset 0 bde4ae8d615e
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TclScript/fuzz_common.tcl	Fri Jun 15 03:10:57 2012 +0200
     1.3 @@ -0,0 +1,392 @@
     1.4 +# 2007 May 10
     1.5 +#
     1.6 +# The author disclaims copyright to this source code.  In place of
     1.7 +# a legal notice, here is a blessing:
     1.8 +#
     1.9 +#    May you do good and not evil.
    1.10 +#    May you find forgiveness for yourself and forgive others.
    1.11 +#    May you share freely, never taking more than you give.
    1.12 +#
    1.13 +#***********************************************************************
    1.14 +#
    1.15 +# $Id: fuzz_common.tcl,v 1.1 2007/05/30 10:36:47 danielk1977 Exp $
    1.16 +
    1.17 +proc fuzz {TemplateList} {
    1.18 +  set n [llength $TemplateList]
    1.19 +  set i [expr {int(rand()*$n)}]
    1.20 +  set r [uplevel 1 subst -novar [list [lindex $TemplateList $i]]]
    1.21 +
    1.22 +  string map {"\n" " "} $r
    1.23 +}
    1.24 +
    1.25 +# Fuzzy generation primitives:
    1.26 +#
    1.27 +#     Literal
    1.28 +#     UnaryOp
    1.29 +#     BinaryOp
    1.30 +#     Expr
    1.31 +#     Table
    1.32 +#     Select
    1.33 +#     Insert
    1.34 +#
    1.35 +
    1.36 +# Returns a string representing an SQL literal.
    1.37 +#
    1.38 +proc Literal {} {
    1.39 +  set TemplateList {
    1.40 +    456 0 -456 1 -1 
    1.41 +    2147483648 2147483647 2147483649 -2147483647 -2147483648 -2147483649
    1.42 +    'The' 'first' 'experiments' 'in' 'hardware' 'fault' 'injection'
    1.43 +    zeroblob(1000)
    1.44 +    NULL
    1.45 +    56.1 -56.1
    1.46 +    123456789.1234567899
    1.47 +  }
    1.48 +  fuzz $TemplateList
    1.49 +}
    1.50 +
    1.51 +# Returns a string containing an SQL unary operator (e.g. "+" or "NOT").
    1.52 +#
    1.53 +proc UnaryOp {} {
    1.54 +  set TemplateList {+ - NOT ~}
    1.55 +  fuzz $TemplateList
    1.56 +}
    1.57 +
    1.58 +# Returns a string containing an SQL binary operator (e.g. "*" or "/").
    1.59 +#
    1.60 +proc BinaryOp {} {
    1.61 +  set TemplateList {
    1.62 +    || * / % + - << >> & | < <= > >= = == != <> AND OR
    1.63 +    LIKE GLOB {NOT LIKE}
    1.64 +  }
    1.65 +  fuzz $TemplateList
    1.66 +}
    1.67 +
    1.68 +# Return the complete text of an SQL expression.
    1.69 +#
    1.70 +set ::ExprDepth 0
    1.71 +proc Expr { {c {}} } {
    1.72 +  incr ::ExprDepth
    1.73 +
    1.74 +  set TemplateList [concat $c $c $c {[Literal]}]
    1.75 +  if {$::ExprDepth < 3} {
    1.76 +    lappend TemplateList \
    1.77 +      {[Expr $c] [BinaryOp] [Expr $c]}                              \
    1.78 +      {[UnaryOp] [Expr $c]}                                         \
    1.79 +      {[Expr $c] ISNULL}                                            \
    1.80 +      {[Expr $c] NOTNULL}                                           \
    1.81 +      {CAST([Expr $c] AS blob)}                                     \
    1.82 +      {CAST([Expr $c] AS text)}                                     \
    1.83 +      {CAST([Expr $c] AS integer)}                                  \
    1.84 +      {CAST([Expr $c] AS real)}                                     \
    1.85 +      {abs([Expr])}                                                 \
    1.86 +      {coalesce([Expr], [Expr])}                                    \
    1.87 +      {hex([Expr])}                                                 \
    1.88 +      {length([Expr])}                                              \
    1.89 +      {lower([Expr])}                                               \
    1.90 +      {upper([Expr])}                                               \
    1.91 +      {quote([Expr])}                                               \
    1.92 +      {random()}                                                    \
    1.93 +      {randomblob(min(max([Expr],1), 500))}                         \
    1.94 +      {typeof([Expr])}                                              \
    1.95 +      {substr([Expr],[Expr],[Expr])}                                \
    1.96 +      {CASE WHEN [Expr $c] THEN [Expr $c] ELSE [Expr $c] END}       \
    1.97 +      {[Literal]} {[Literal]} {[Literal]}                           \
    1.98 +      {[Literal]} {[Literal]} {[Literal]}                           \
    1.99 +      {[Literal]} {[Literal]} {[Literal]}                           \
   1.100 +      {[Literal]} {[Literal]} {[Literal]}
   1.101 +  }
   1.102 +  if {$::SelectDepth < 4} {
   1.103 +    lappend TemplateList \
   1.104 +      {([Select 1])}                       \
   1.105 +      {[Expr $c] IN ([Select 1])}          \
   1.106 +      {[Expr $c] NOT IN ([Select 1])}      \
   1.107 +      {EXISTS ([Select 1])}                \
   1.108 +  } 
   1.109 +  set res [fuzz $TemplateList]
   1.110 +  incr ::ExprDepth -1
   1.111 +  return $res
   1.112 +}
   1.113 +
   1.114 +# Return a valid table name.
   1.115 +#
   1.116 +set ::TableList [list]
   1.117 +proc Table {} {
   1.118 +  set TemplateList [concat sqlite_master $::TableList]
   1.119 +  fuzz $TemplateList
   1.120 +}
   1.121 +
   1.122 +# Return one of:
   1.123 +#
   1.124 +#     "SELECT DISTINCT", "SELECT ALL" or "SELECT"
   1.125 +#
   1.126 +proc SelectKw {} {
   1.127 +  set TemplateList {
   1.128 +    "SELECT DISTINCT"
   1.129 +    "SELECT ALL"
   1.130 +    "SELECT"
   1.131 +  }
   1.132 +  fuzz $TemplateList
   1.133 +}
   1.134 +
   1.135 +# Return a result set for a SELECT statement.
   1.136 +#
   1.137 +proc ResultSet {{nRes 0} {c ""}} {
   1.138 +  if {$nRes == 0} {
   1.139 +    set nRes [expr {rand()*2 + 1}]
   1.140 +  }
   1.141 +
   1.142 +  set aRes [list]
   1.143 +  for {set ii 0} {$ii < $nRes} {incr ii} {
   1.144 +    lappend aRes [Expr $c]
   1.145 +  }
   1.146 +
   1.147 +  join $aRes ", "
   1.148 +}
   1.149 +
   1.150 +set ::SelectDepth 0
   1.151 +set ::ColumnList [list]
   1.152 +proc SimpleSelect {{nRes 0}} {
   1.153 +
   1.154 +  set TemplateList {
   1.155 +      {[SelectKw] [ResultSet $nRes]}
   1.156 +  }
   1.157 +
   1.158 +  # The ::SelectDepth variable contains the number of ancestor SELECT
   1.159 +  # statements (i.e. for a top level SELECT it is set to 0, for a
   1.160 +  # sub-select 1, for a sub-select of a sub-select 2 etc.).
   1.161 +  #
   1.162 +  # If this is already greater than 3, do not generate a complicated
   1.163 +  # SELECT statement. This tends to cause parser stack overflow (too
   1.164 +  # boring to bother with).
   1.165 +  #
   1.166 +  if {$::SelectDepth < 4} {
   1.167 +    lappend TemplateList \
   1.168 +        {[SelectKw] [ResultSet $nRes $::ColumnList] FROM ([Select])}     \
   1.169 +        {[SelectKw] [ResultSet $nRes] FROM ([Select])}                   \
   1.170 +        {[SelectKw] [ResultSet $nRes $::ColumnList] FROM [Table]}        \
   1.171 +        {
   1.172 +             [SelectKw] [ResultSet $nRes $::ColumnList] 
   1.173 +             FROM ([Select]) 
   1.174 +             GROUP BY [Expr]
   1.175 +             HAVING [Expr]
   1.176 +        }                                                                \
   1.177 +
   1.178 +    if {0 == $nRes} {
   1.179 +      lappend TemplateList                                               \
   1.180 +          {[SelectKw] * FROM ([Select])}                                 \
   1.181 +          {[SelectKw] * FROM [Table]}                                    \
   1.182 +          {[SelectKw] * FROM [Table] WHERE [Expr $::ColumnList]}         \
   1.183 +          {
   1.184 +             [SelectKw] * 
   1.185 +             FROM [Table],[Table] AS t2 
   1.186 +             WHERE [Expr $::ColumnList] 
   1.187 +          } {
   1.188 +             [SelectKw] * 
   1.189 +             FROM [Table] LEFT OUTER JOIN [Table] AS t2 
   1.190 +             ON [Expr $::ColumnList]
   1.191 +             WHERE [Expr $::ColumnList] 
   1.192 +          }
   1.193 +    }
   1.194 +  } 
   1.195 +
   1.196 +  fuzz $TemplateList
   1.197 +}
   1.198 +
   1.199 +# Return a SELECT statement.
   1.200 +#
   1.201 +# If boolean parameter $isExpr is set to true, make sure the
   1.202 +# returned SELECT statement returns a single column of data.
   1.203 +#
   1.204 +proc Select {{nMulti 0}} {
   1.205 +  set TemplateList {
   1.206 +    {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
   1.207 +    {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
   1.208 +    {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
   1.209 +    {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} {[SimpleSelect $nMulti]} 
   1.210 +    {[SimpleSelect $nMulti] ORDER BY [Expr] DESC}
   1.211 +    {[SimpleSelect $nMulti] ORDER BY [Expr] ASC}
   1.212 +    {[SimpleSelect $nMulti] ORDER BY [Expr] ASC, [Expr] DESC}
   1.213 +    {[SimpleSelect $nMulti] ORDER BY [Expr] LIMIT [Expr] OFFSET [Expr]}
   1.214 +  }
   1.215 +
   1.216 +  if {$::SelectDepth < 4} {
   1.217 +    if {$nMulti == 0} {
   1.218 +      set nMulti [expr {(rand()*2)+1}]
   1.219 +    }
   1.220 +    lappend TemplateList                                             \
   1.221 +        {[SimpleSelect $nMulti] UNION     [Select $nMulti]}          \
   1.222 +        {[SimpleSelect $nMulti] UNION ALL [Select $nMulti]}          \
   1.223 +        {[SimpleSelect $nMulti] EXCEPT    [Select $nMulti]}          \
   1.224 +        {[SimpleSelect $nMulti] INTERSECT [Select $nMulti]}
   1.225 +  }
   1.226 +
   1.227 +  incr ::SelectDepth
   1.228 +  set res [fuzz $TemplateList]
   1.229 +  incr ::SelectDepth -1
   1.230 +  set res
   1.231 +}
   1.232 +
   1.233 +# Generate and return a fuzzy INSERT statement.
   1.234 +#
   1.235 +proc Insert {} {
   1.236 +  set TemplateList {
   1.237 +      {INSERT INTO [Table] VALUES([Expr], [Expr], [Expr]);}
   1.238 +      {INSERT INTO [Table] VALUES([Expr], [Expr], [Expr], [Expr]);}
   1.239 +      {INSERT INTO [Table] VALUES([Expr], [Expr]);}
   1.240 +  }
   1.241 +  fuzz $TemplateList
   1.242 +}
   1.243 +
   1.244 +proc Column {} {
   1.245 +  fuzz $::ColumnList
   1.246 +}
   1.247 +
   1.248 +# Generate and return a fuzzy UPDATE statement.
   1.249 +#
   1.250 +proc Update {} {
   1.251 +  set TemplateList {
   1.252 +    {UPDATE [Table] 
   1.253 +     SET [Column] = [Expr $::ColumnList] 
   1.254 +     WHERE [Expr $::ColumnList]}
   1.255 +  }
   1.256 +  fuzz $TemplateList
   1.257 +}
   1.258 +
   1.259 +proc Delete {} {
   1.260 +  set TemplateList {
   1.261 +    {DELETE FROM [Table] WHERE [Expr $::ColumnList]}
   1.262 +  }
   1.263 +  fuzz $TemplateList
   1.264 +}
   1.265 +
   1.266 +proc Statement {} {
   1.267 +  set TemplateList {
   1.268 +    {[Update]}
   1.269 +    {[Insert]}
   1.270 +    {[Select]}
   1.271 +    {[Delete]}
   1.272 +  }
   1.273 +  fuzz $TemplateList
   1.274 +}
   1.275 +
   1.276 +# Return an identifier. This just chooses randomly from a fixed set
   1.277 +# of strings.
   1.278 +proc Identifier {} {
   1.279 +  set TemplateList {
   1.280 +    This just chooses randomly a fixed 
   1.281 +    We would also thank the developers 
   1.282 +    for their analysis Samba
   1.283 +  }
   1.284 +  fuzz $TemplateList
   1.285 +}
   1.286 +
   1.287 +proc Check {} {
   1.288 +  # Use a large value for $::SelectDepth, because sub-selects are
   1.289 +  # not allowed in expressions used by CHECK constraints.
   1.290 +  #
   1.291 +  set sd $::SelectDepth 
   1.292 +  set ::SelectDepth 500
   1.293 +  set TemplateList {
   1.294 +    {}
   1.295 +    {CHECK ([Expr])}
   1.296 +  }
   1.297 +  set res [fuzz $TemplateList]
   1.298 +  set ::SelectDepth $sd
   1.299 +  set res
   1.300 +}
   1.301 +
   1.302 +proc Coltype {} {
   1.303 +  set TemplateList {
   1.304 +    {INTEGER PRIMARY KEY}
   1.305 +    {VARCHAR [Check]}
   1.306 +    {PRIMARY KEY}
   1.307 +  }
   1.308 +  fuzz $TemplateList
   1.309 +}
   1.310 +
   1.311 +proc DropTable {} {
   1.312 +  set TemplateList {
   1.313 +    {DROP TABLE IF EXISTS [Identifier]}
   1.314 +  }
   1.315 +  fuzz $TemplateList
   1.316 +}
   1.317 +
   1.318 +proc CreateView {} {
   1.319 +  set TemplateList {
   1.320 +    {CREATE VIEW [Identifier] AS [Select]}
   1.321 +  }
   1.322 +  fuzz $TemplateList
   1.323 +}
   1.324 +proc DropView {} {
   1.325 +  set TemplateList {
   1.326 +    {DROP VIEW IF EXISTS [Identifier]}
   1.327 +  }
   1.328 +  fuzz $TemplateList
   1.329 +}
   1.330 +
   1.331 +proc CreateTable {} {
   1.332 +  set TemplateList {
   1.333 +    {CREATE TABLE [Identifier]([Identifier] [Coltype], [Identifier] [Coltype])}
   1.334 +    {CREATE TEMP TABLE [Identifier]([Identifier] [Coltype])}
   1.335 +  }
   1.336 +  fuzz $TemplateList
   1.337 +}
   1.338 +
   1.339 +proc CreateOrDropTableOrView {} {
   1.340 +  set TemplateList {
   1.341 +    {[CreateTable]}
   1.342 +    {[DropTable]}
   1.343 +    {[CreateView]}
   1.344 +    {[DropView]}
   1.345 +  }
   1.346 +  fuzz $TemplateList
   1.347 +}
   1.348 +
   1.349 +########################################################################
   1.350 +
   1.351 +set ::log [open fuzzy.log w]
   1.352 +
   1.353 +#
   1.354 +# Usage: do_fuzzy_test <testname> ?<options>?
   1.355 +# 
   1.356 +#     -template
   1.357 +#     -errorlist
   1.358 +#     -repeats
   1.359 +#     
   1.360 +proc do_fuzzy_test {testname args} {
   1.361 +  set ::fuzzyopts(-errorlist) [list]
   1.362 +  set ::fuzzyopts(-repeats) $::REPEATS
   1.363 +  array set ::fuzzyopts $args
   1.364 +
   1.365 +  lappend ::fuzzyopts(-errorlist) {parser stack overflow} 
   1.366 +  lappend ::fuzzyopts(-errorlist) {ORDER BY}
   1.367 +  lappend ::fuzzyopts(-errorlist) {GROUP BY}
   1.368 +  lappend ::fuzzyopts(-errorlist) {datatype mismatch}
   1.369 +
   1.370 +  for {set ii 0} {$ii < $::fuzzyopts(-repeats)} {incr ii} {
   1.371 +    do_test ${testname}.$ii {
   1.372 +      set ::sql [subst $::fuzzyopts(-template)]
   1.373 +      puts $::log $::sql
   1.374 +      flush $::log
   1.375 +      set rc [catch {execsql $::sql} msg]
   1.376 +      set e 1
   1.377 +      if {$rc} {
   1.378 +        set e 0
   1.379 +        foreach error $::fuzzyopts(-errorlist) {
   1.380 +          if {0 == [string first $error $msg]} {
   1.381 +            set e 1
   1.382 +            break
   1.383 +          }
   1.384 +        }
   1.385 +      }
   1.386 +      if {$e == 0} {
   1.387 +        puts ""
   1.388 +        puts $::sql
   1.389 +        puts $msg
   1.390 +      }
   1.391 +      set e
   1.392 +    } {1}
   1.393 +  }
   1.394 +}
   1.395 +