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