# 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}
}
}