SQLite

# 3 == SQLITE_WIN32_MALLOC_VALIDATE: Validate the Win32 native heap per call.
# 4 == SQLITE_DEBUG_OS_TRACE: Enables output from the OSTRACE() macros.
# 5 == SQLITE_ENABLE_IOTRACE: Enables output from the IOTRACE() macros.
#
!IFNDEF DEBUG
DEBUG = 0
!ENDIF

# Enable use of available compiler optimizations?  Normally, this should be
# non-zero.  Setting this to zero, thus disabling all compiler optimizations,
# can be useful for testing.
#
!IFNDEF OPTIMIZATIONS
OPTIMIZATIONS = 2
!ENDIF

# Check for the predefined command macro CC.  This should point to the compiler
# binary for the target platform.  If it is not defined, simply define it to
# the legacy default value 'cl.exe'.
#
!IFNDEF CC
CC = cl.exe

#
!IFNDEF TCLSH_CMD
TCLSH_CMD = tclsh85
!ENDIF

# Compiler options needed for programs that use the readline() library.
#
!IFNDEF READLINE_FLAGS
READLINE_FLAGS = -DHAVE_READLINE=0
!ENDIF

# The library that programs using readline() must link against.
#
!IFNDEF LIBREADLINE
LIBREADLINE =
!ENDIF

# Should the database engine be compiled threadsafe
#
TCC = $(TCC) -DSQLITE_THREADSAFE=1
RCC = $(RCC) -DSQLITE_THREADSAFE=1

# Do threads override each others locks by default (1), or do we test (-1)

RCC = $(RCC) $(OPT_FEATURE_FLAGS)

# Add in any optional parameters specified on the make commane line
# ie.  make "OPTS=-DSQLITE_ENABLE_FOO=1 -DSQLITE_OMIT_FOO=1".
TCC = $(TCC) $(OPTS)
RCC = $(RCC) $(OPTS)

# If symbols are enabled, enable PDBs.
# If debugging is enabled, disable all optimizations and enable PDBs.
# If compiling for debugging, add some defines.
!IF $(DEBUG)>0
TCC = $(TCC) -Od -D_DEBUG
BCC = $(BCC) -Od -D_DEBUG
TCC = $(TCC) -D_DEBUG
BCC = $(BCC) -D_DEBUG
RCC = $(RCC) -D_DEBUG
!ELSE
!ENDIF

# If optimizations are enabled or disabled (either implicitly or
# explicitly), add the necessary flags.
!IF $(DEBUG)>0 || $(OPTIMIZATIONS)==0
TCC = $(TCC) -Od
BCC = $(BCC) -Od
!ELSEIF $(OPTIMIZATIONS)>=3
TCC = $(TCC) -Ox
BCC = $(BCC) -Ox
!ELSEIF $(OPTIMIZATIONS)==2
TCC = $(TCC) -O2
BCC = $(BCC) -O2
!ELSEIF $(OPTIMIZATIONS)==1
TCC = $(TCC) -O1
BCC = $(BCC) -O1
!ENDIF

# If symbols are enabled (or compiling for debugging), enable PDBs.
!IF $(DEBUG)>0 || $(SYMBOLS)!=0
TCC = $(TCC) -Zi
BCC = $(BCC) -Zi
!ENDIF

# If ICU support is enabled, add the compiler options for it.
!IF $(USE_ICU)!=0

# If ICU support is enabled, add the linker options for it.
!IF $(USE_ICU)!=0
LTLIBPATHS = $(LTLIBPATHS) /LIBPATH:$(ICULIBDIR)
LTLIBS = $(LTLIBS) $(LIBICU)
!ENDIF

# nawk compatible awk.
!IFNDEF NAWK
NAWK = gawk.exe
!ENDIF

# You should not have to change anything below this line
###############################################################################

# Object files for the SQLite library (non-amalgamation).
#
LIBOBJS0 = vdbe.lo parse.lo alter.lo analyze.lo attach.lo auth.lo \

#***********************************************************************
# This file implements some common TCL routines used for regression
# testing the SQLite library
#
# $Id: tester.tcl,v 1.143 2009/04/09 01:23:49 drh Exp $

#-------------------------------------------------------------------------
# The commands provided by the code in this file to help with creating 
# The commands provided by the code in this file to help with creating
# test cases are as follows:
#
# Commands to manipulate the db and the file-system at a high level:
#
#      is_relative_file
#      test_pwd
#      get_pwd

#
#      dbcksum                DB DBNAME
#      allcksum               ?DB?
#      cksum                  ?DB?
#
# Commands to execute/explain SQL statements:
#
#      memdbsql               SQL
#      stepsql                DB SQL
#      execsql2               SQL
#      explain_no_trace       SQL
#      explain                SQL ?DB?
#      catchsql               SQL ?DB?
#      execsql                SQL ?DB?
#

#      wal_is_wal_mode
#      wal_set_journal_mode   ?DB?
#      wal_check_journal_mode TESTNAME?DB?
#      permutation
#      presql
#

# Set the precision of FP arithmatic used by the interpreter. And 
# Set the precision of FP arithmatic used by the interpreter. And
# configure SQLite to take database file locks on the page that begins
# 64KB into the database file instead of the one 1GB in. This means
# the code that handles that special case can be tested without creating
# very large database files.
#
set tcl_precision 15
sqlite3_test_control_pending_byte 0x0010000


# If the pager codec is available, create a wrapper for the [sqlite3] 
# If the pager codec is available, create a wrapper for the [sqlite3]
# command that appends "-key {xyzzy}" to the command line. i.e. this:
#
#     sqlite3 db test.db
#
# becomes
#
#     sqlite3 db test.db -key {xyzzy}

      }
      if {[info exists ::G(perm:dbconfig)]} {
        set ::dbhandle [lindex $args 0]
        uplevel #0 $::G(perm:dbconfig)
      }
      set res
    } else {
      # This command is not opening a new database connection. Pass the 
      # This command is not opening a new database connection. Pass the
      # arguments through to the C implementation as the are.
      #
      uplevel 1 sqlite_orig $args
    }
  }
}

        file delete -force $filename
      } else {
        file delete $filename
      }
    }
  }
}

if {$::tcl_platform(platform) eq "windows"} {
  proc do_remove_win32_dir {args} {
    set nRetry [getFileRetries]     ;# Maximum number of retries.
    set nDelay [getFileRetryDelay]  ;# Delay in ms before retrying.

    foreach dirName $args {
      # On windows, sometimes even a [remove_win32_dir] can fail just after
      # a directory is emptied. The cause is usually "tag-alongs" - programs
      # like anti-virus software, automatic backup tools and various explorer
      # extensions that keep a file open a little longer than we expect,
      # causing the delete to fail.
      #
      # The solution is to wait a short amount of time before retrying the
      # removal.
      #
      if {$nRetry > 0} {
        for {set i 0} {$i < $nRetry} {incr i} {
          set rc [catch {
            remove_win32_dir $dirName
          } msg]
          if {$rc == 0} break
          if {$nDelay > 0} { after $nDelay }
        }
        if {$rc} { error $msg }
      } else {
        remove_win32_dir $dirName
      }
    }
  }

  proc do_delete_win32_file {args} {
    set nRetry [getFileRetries]     ;# Maximum number of retries.
    set nDelay [getFileRetryDelay]  ;# Delay in ms before retrying.

    foreach fileName $args {
      # On windows, sometimes even a [delete_win32_file] can fail just after
      # a file is closed. The cause is usually "tag-alongs" - programs like
      # anti-virus software, automatic backup tools and various explorer
      # extensions that keep a file open a little longer than we expect,
      # causing the delete to fail.
      #
      # The solution is to wait a short amount of time before retrying the
      # delete.
      #
      if {$nRetry > 0} {
        for {set i 0} {$i < $nRetry} {incr i} {
          set rc [catch {
            delete_win32_file $fileName
          } msg]
          if {$rc == 0} break
          if {$nDelay > 0} { after $nDelay }
        }
        if {$rc} { error $msg }
      } else {
        delete_win32_file $fileName
      }
    }
  }
}

proc execpresql {handle args} {
  trace remove execution $handle enter [list execpresql $handle]
  if {[info exists ::G(perm:presql)]} {
    $handle eval $::G(perm:presql)
  }
}

# The following block only runs the first time this file is sourced. It
# does not run in slave interpreters (since the ::cmdlinearg array is
# populated before the test script is run in slave interpreters).
#
if {[info exists cmdlinearg]==0} {

  # Parse any options specified in the $argv array. This script accepts the 
  # following options: 
  # Parse any options specified in the $argv array. This script accepts the
  # following options:
  #
  #   --pause
  #   --soft-heap-limit=NN
  #   --maxerror=NN
  #   --malloctrace=N
  #   --backtrace=N
  #   --binarylog=N

  set cmdlinearg(start)             ""
  set cmdlinearg(match)             ""

  set leftover [list]
  foreach a $argv {
    switch -regexp -- $a {
      {^-+pause$} {
        # Wait for user input before continuing. This is to give the user an 
        # Wait for user input before continuing. This is to give the user an
        # opportunity to connect profiling tools to the process.
        puts -nonewline "Press RETURN to begin..."
        flush stdout
        gets stdin
      }
      {^-+soft-heap-limit=.+$} {
        foreach {dummy cmdlinearg(soft-heap-limit)} [split $a =] break

    }
  }
  set argv $leftover

  # Install the malloc layer used to inject OOM errors. And the 'automatic'
  # extensions. This only needs to be done once for the process.
  #
  sqlite3_shutdown 
  install_malloc_faultsim 1 
  sqlite3_shutdown
  install_malloc_faultsim 1
  sqlite3_initialize
  autoinstall_test_functions

  # If the --binarylog option was specified, create the logging VFS. This
  # call installs the new VFS as the default for all SQLite connections.
  #
  if {$cmdlinearg(binarylog)} {

# Increment the number of tests run
#
proc incr_ntest {} {
  set_test_counter count [expr [set_test_counter count] + 1]
}


# Invoke the do_test procedure to run a single test 
# Invoke the do_test procedure to run a single test
#
proc do_test {name cmd expected} {
  global argv cmdlinearg

  fix_testname name

  sqlite3_memdebug_settitle $name

#  if {[llength $argv]==0} { 
#  if {[llength $argv]==0} {
#    set go 1
#  } else {
#    set go 0
#    foreach pattern $argv {
#      if {[string match $pattern $name]} {
#        set go 1
#        break

  uplevel [list do_test $name [
    subst -nocommands { realnum_normalize [ $cmd ] }
  ] [realnum_normalize $expected]]
}

proc fix_testname {varname} {
  upvar $varname testname
  if {[info exists ::testprefix] 
  if {[info exists ::testprefix]
   && [string is digit [string range $testname 0 0]]
  } {
    set testname "${::testprefix}-$testname"
  }
}
    

proc do_execsql_test {testname sql {result {}}} {
  fix_testname testname
  uplevel do_test [list $testname] [list "execsql {$sql}"] [list [list {*}$result]]
}
proc do_catchsql_test {testname sql result} {
  fix_testname testname
  uplevel do_test [list $testname] [list "catchsql {$sql}"] [list $result]

proc delete_all_data {} {
  db eval {SELECT tbl_name AS t FROM sqlite_master WHERE type = 'table'} {
    db eval "DELETE FROM '[string map {' ''} $t]'"
  }
}

# Run an SQL script.  
# Run an SQL script.
# Return the number of microseconds per statement.
#
proc speed_trial {name numstmt units sql} {
  puts -nonewline [format {%-21.21s } $name...]
  flush stdout
  set speed [time {sqlite3_exec_nr db $sql}]
  set tm [lindex $speed 0]

  db eval $sql data {
    foreach f $data(*) {
      lappend result $f $data($f)
    }
  }
  return $result
}

# Use a temporary in-memory database to execute SQL statements
#
proc memdbsql {sql} {
  sqlite3 memdb :memory:
  set result [memdb eval $sql]
  memdb close
  return $result
}

# Use the non-callback API to execute multiple SQL statements
#
proc stepsql {dbptr sql} {
  set sql [string trim $sql]
  set r 0
  while {[string length $sql]>0} {

  set blocksize ""
  set crashdelay 1
  set prngseed 0
  set tclbody {}
  set crashfile ""
  set dc ""
  set sql [lindex $args end]
  

  for {set ii 0} {$ii < [llength $args]-1} {incr ii 2} {
    set z [lindex $args $ii]
    set n [string length $z]
    set z2 [lindex $args [expr $ii+1]]

    if     {$n>1 && [string first $z -delay]==0}     {set crashdelay $z2} \
    elseif {$n>1 && [string first $z -seed]==0}      {set prngseed $z2} \
    elseif {$n>1 && [string first $z -file]==0}      {set crashfile $z2}  \
    elseif {$n>1 && [string first $z -tclbody]==0}   {set tclbody $z2}  \
    elseif {$n>1 && [string first $z -blocksize]==0} {set blocksize "-s $z2" } \
    elseif {$n>1 && [string first $z -characteristics]==0} {set dc "-c {$z2}" } \
    else   { error "Unrecognized option: $z" }
  }

  if {$crashfile eq ""} {
    error "Compulsory option -file missing"
  }

  # $crashfile gets compared to the native filename in 
  # $crashfile gets compared to the native filename in
  # cfSync(), which can be different then what TCL uses by
  # default, so here we force it to the "nativename" format.
  set cfile [string map {\\ \\\\} [file nativename [file join [get_pwd] $crashfile]]]

  set f [open crash.tcl w]
  puts $f "sqlite3_crash_enable 1"
  puts $f "sqlite3_crashparams $blocksize $dc $crashdelay $cfile"

    puts $f   "$sql"
    puts $f "}"
  }
  close $f
  set r [catch {
    exec [info nameofexec] crash.tcl >@stdout
  } msg]
  

  # Windows/ActiveState TCL returns a slightly different
  # error message.  We map that to the expected message
  # so that we don't have to change all of the test
  # cases.
  if {$::tcl_platform(platform)=="windows"} {
    if {$msg=="child killed: unknown signal"} {
      set msg "child process exited abnormally"
    }
  }
  

  lappend r $msg
}

proc run_ioerr_prep {} {
  set ::sqlite_io_error_pending 0
  catch {db close}
  catch {db2 close}

  }
  expr 0
}

# Usage: do_ioerr_test <test number> <options...>
#
# This proc is used to implement test cases that check that IO errors
# are correctly handled. The first argument, <test number>, is an integer 
# are correctly handled. The first argument, <test number>, is an integer
# used to name the tests executed by this proc. Options are as follows:
#
#     -tclprep          TCL script to run to prepare test.
#     -sqlprep          SQL script to run to prepare test.
#     -tclbody          TCL script to run with IO error simulation.
#     -sqlbody          TCL script to run with IO error simulation.
#     -exclude          List of 'N' values not to test.

  set ::ioerropts(-ckrefcount) 0
  set ::ioerropts(-restoreprng) 1
  array set ::ioerropts $args

  # TEMPORARY: For 3.5.9, disable testing of extended result codes. There are
  # a couple of obscure IO errors that do not return them.
  set ::ioerropts(-erc) 0
  

  # Create a single TCL script from the TCL and SQL specified
  # as the body of the test.
  set ::ioerrorbody {}
  if {[info exists ::ioerropts(-tclbody)]} {
    append ::ioerrorbody "$::ioerropts(-tclbody)\n"
  }
  if {[info exists ::ioerropts(-sqlbody)]} {

  set ::go 1
  #reset_prng_state
  for {set n $::ioerropts(-start)} {$::go} {incr n} {
    set ::TN $n
    incr ::ioerropts(-count) -1
    if {$::ioerropts(-count)<0} break
 

    # Skip this IO error if it was specified with the "-exclude" option.
    if {[info exists ::ioerropts(-exclude)]} {
      if {[lsearch $::ioerropts(-exclude) $n]!=-1} continue
    }
    if {$::ioerropts(-restoreprng)} {
      restore_prng_state
    }

    # Delete the files test.db and test2.db, then execute the TCL and 
    # Delete the files test.db and test2.db, then execute the TCL and
    # SQL (in that order) to prepare for the test case.
    do_test $testname.$n.1 {
      run_ioerr_prep
    } {0}

    # Read the 'checksum' of the database.
    if {$::ioerropts(-cksum)} {
      set ::checksum [cksum]
    }

    # Set the Nth IO error to fail.
    do_test $testname.$n.2 [subst {
      set ::sqlite_io_error_persist $::ioerropts(-persist)
      set ::sqlite_io_error_pending $n
    }] $n

    # Execute the TCL script created for the body of this test. If
    # at least N IO operations performed by SQLite as a result of 
    # at least N IO operations performed by SQLite as a result of
    # the script, the Nth will fail.
    do_test $testname.$n.3 {
      set ::sqlite_io_error_hit 0
      set ::sqlite_io_error_hardhit 0
      set r [catch $::ioerrorbody msg]
      set ::errseen $r
      set rc [sqlite3_errcode $::DB]

      #puts "s=$s r=$r q=$q"
      expr { ($s && !$r && !$q) || (!$s && $r && $q) }
    } {1}

    set ::sqlite_io_error_hit 0
    set ::sqlite_io_error_pending 0

    # Check that no page references were leaked. There should be 
    # a single reference if there is still an active transaction, 
    # Check that no page references were leaked. There should be
    # a single reference if there is still an active transaction,
    # or zero otherwise.
    #
    # UPDATE: If the IO error occurs after a 'BEGIN' but before any
    # locks are established on database files (i.e. if the error 
    # locks are established on database files (i.e. if the error
    # occurs while attempting to detect a hot-journal file), then
    # there may 0 page references and an active transaction according
    # to [sqlite3_get_autocommit].
    #
    if {$::go && $::sqlite_io_error_hardhit && $::ioerropts(-ckrefcount)} {
      do_test $testname.$n.4 {
        set bt [btree_from_db db]
        db_enter db
        array set stats [btree_pager_stats $bt]
        db_leave db
        set nRef $stats(ref)
        expr {$nRef == 0 || ([sqlite3_get_autocommit db]==0 && $nRef == 1)}
      } {1}
    }

    # If there is an open database handle and no open transaction, 
    # If there is an open database handle and no open transaction,
    # and the pager is not running in exclusive-locking mode,
    # check that the pager is in "unlocked" state. Theoretically,
    # if a call to xUnlock() failed due to an IO error the underlying
    # file may still be locked.
    #
    ifcapable pragma {
      if { [info commands db] ne ""

    append txt $prag-[$db eval "PRAGMA $prag"]\n
  }
  # puts txt=$txt
  return [md5 $txt]
}

# Generate a checksum based on the contents of a single database with
# a database connection.  The name of the database is $dbname.  
# a database connection.  The name of the database is $dbname.
# Examples of $dbname are "temp" or "main".
#
proc dbcksum {db dbname} {
  if {$dbname=="temp"} {
    set master sqlite_temp_master
  } else {
    set master $dbname.sqlite_master

  ifcapable trigger&&foreignkey {
    $db eval "PRAGMA foreign_keys = $pk"
  }
}

#-------------------------------------------------------------------------
# If a test script is executed with global variable $::G(perm:name) set to
# "wal", then the tests are run in WAL mode. Otherwise, they should be run 
# in rollback mode. The following Tcl procs are used to make this less 
# "wal", then the tests are run in WAL mode. Otherwise, they should be run
# in rollback mode. The following Tcl procs are used to make this less
# intrusive:
#
#   wal_set_journal_mode ?DB?
#
#     If running a WAL test, execute "PRAGMA journal_mode = wal" using
#     connection handle DB. Otherwise, this command is a no-op.
#
#   wal_check_journal_mode TESTNAME ?DB?
#
#     If running a WAL test, execute a tests case that fails if the main
#     database for connection handle DB is not currently a WAL database.
#     Otherwise (if not running a WAL permutation) this is a no-op.
#
#   wal_is_wal_mode
#   
#
#     Returns true if this test should be run in WAL mode. False otherwise.
# 
#
proc wal_is_wal_mode {} {
  expr {[permutation] eq "wal"}
}
proc wal_set_journal_mode {{db db}} {
  if { [wal_is_wal_mode] } {
    $db eval "PRAGMA journal_mode = WAL"
  }

  # is not thread-safe.
  #
  if {[info exists ::run_thread_tests_called]==0} {
    do_test ${tail}-closeallfiles { expr {$::sqlite_open_file_count>0} } {0}
  }
  set ::sqlite_open_file_count 0

  # Test that the global "shared-cache" setting was not altered by 
  # Test that the global "shared-cache" setting was not altered by
  # the test script.
  #
  ifcapable shared_cache { 
  ifcapable shared_cache {
    set res [expr {[sqlite3_enable_shared_cache] == $scs}]
    do_test ${tail}-sharedcachesetting [list set {} $res] 1
  }

  # Add some info to the output.
  #
  puts "Time: $tail $ms ms"

# This test should work the same with and without SQLITE_ENABLE_STAT3
#
###############################################################################

set testdir [file dirname $argv0]
source $testdir/tester.tcl

# TODO: Reenable this test.
  finish_test
  return

ifcapable !stat3 {
  finish_test
  return
}

do_execsql_test wild001.01 {
  CREATE TABLE "items" ("id" INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, "secid" integer, "parent_id" integer, "metadata_type" integer, "guid" varchar(255), "media_item_count" integer, "title" varchar(255), "title_sort" varchar(255) COLLATE NOCASE, "original_title" varchar(255), "studio" varchar(255), "rating" float, "rating_count" integer, "tagline" varchar(255), "summary" text, "trivia" text, "quotes" text, "content_rating" varchar(255), "content_rating_age" integer, "index" integer, "absolute_index" integer, "duration" integer, "user_thumb_url" varchar(255), "user_art_url" varchar(255), "user_banner_url" varchar(255), "user_music_url" varchar(255), "user_fields" varchar(255), "tags_genre" varchar(255), "tags_collection" varchar(255), "tags_director" varchar(255), "tags_writer" varchar(255), "tags_star" varchar(255), "originally_available_at" datetime, "available_at" datetime, "expires_at" datetime, "refreshed_at" datetime, "year" integer, "added_at" datetime, "created_at" datetime, "updated_at" datetime, "deleted_at" datetime, "tags_country" varchar(255), "extra_data" varchar(255), "hash" varchar(255));

if {$tcl_platform(platform)!="windows"} return

set testdir [file dirname $argv0]
source $testdir/tester.tcl
set testprefix win32longpath

proc do_remove_win32_dir {args} {
  set nRetry [getFileRetries]     ;# Maximum number of retries.
  set nDelay [getFileRetryDelay]  ;# Delay in ms before retrying.

  foreach dirName $args {
    # On windows, sometimes even a [remove_win32_dir] can fail just after
    # a directory is emptied. The cause is usually "tag-alongs" - programs
    # like anti-virus software, automatic backup tools and various explorer
    # extensions that keep a file open a little longer than we expect,
    # causing the delete to fail.
    #
    # The solution is to wait a short amount of time before retrying the
    # removal.
    #
    if {$nRetry > 0} {
      for {set i 0} {$i < $nRetry} {incr i} {
        set rc [catch {
          remove_win32_dir $dirName
        } msg]
        if {$rc == 0} break
        if {$nDelay > 0} { after $nDelay }
      }
      if {$rc} { error $msg }
    } else {
      remove_win32_dir $dirName
    }
  }
}

proc do_delete_win32_file {args} {
  set nRetry [getFileRetries]     ;# Maximum number of retries.
  set nDelay [getFileRetryDelay]  ;# Delay in ms before retrying.

  foreach fileName $args {
    # On windows, sometimes even a [delete_win32_file] can fail just after
    # a file is closed. The cause is usually "tag-alongs" - programs like
    # anti-virus software, automatic backup tools and various explorer
    # extensions that keep a file open a little longer than we expect,
    # causing the delete to fail.
    #
    # The solution is to wait a short amount of time before retrying the
    # delete.
    #
    if {$nRetry > 0} {
      for {set i 0} {$i < $nRetry} {incr i} {
        set rc [catch {
          delete_win32_file $fileName
        } msg]
        if {$rc == 0} break
        if {$nDelay > 0} { after $nDelay }
      }
      if {$rc} { error $msg }
    } else {
      delete_win32_file $fileName
    }
  }
}

db close
set path [file nativename [get_pwd]]
sqlite3 db [file join $path test.db] -vfs win32-longpath

do_test 1.1 {
  db eval {
    BEGIN EXCLUSIVE;