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

  }

}