SQLite

#
#    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.
#
#***********************************************************************
# This file runs all tests.
#
# $Id: quick.test,v 1.91 2009/01/03 10:41:29 danielk1977 Exp $

proc lshift {lvar} {
  upvar $lvar l
  set ret [lindex $l 0]
  set l [lrange $l 1 end]
  return $ret
}

  misc7.test
  misuse.test
  mutex2.test
  onefile.test
  permutations.test
  quick.test
  savepoint4.test
  savepoint6.test
  select9.test
  soak.test
  speed1.test
  speed1p.test
  speed2.test
  speed3.test
  speed4.test

# 2009 January 3
#
# 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: savepoint6.test,v 1.1 2009/01/03 10:41:29 danielk1977 Exp $

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

do_test savepoint6-1.1 {
  execsql {
    PRAGMA auto_vacuum = incremental;
    CREATE TABLE t1(x, y);
    CREATE UNIQUE INDEX i1 ON t1(x);
    CREATE INDEX i2 ON t1(y);
  }
} {}

#--------------------------------------------------------------------------
# In memory database state.
#
# ::lSavepoint is a list containing one entry for each active savepoint. The
# first entry in the list corresponds to the most recently opened savepoint.
# Each entry consists of two elements:
#
#   1. The savepoint name.
#
#   2. A serialized Tcl array representing the contents of table t1 at the
#      start of the savepoint. The keys of the array are the x values. The
#      values are the y values.
#  
# Array ::aEntry contains the contents of database table t1. Array keys are
# x values, the array data values are y values.
#
set lSavepoint [list]
array set aEntry [list]

proc x_to_y {x} {
  set nChar [expr int(rand()*250) + 250]
  set str " $nChar [string repeat $x. $nChar]"
  string range $str 1 $nChar
}
#--------------------------------------------------------------------------

#-------------------------------------------------------------------------
# Procs to operate on database:
#
#   savepoint NAME
#   rollback  NAME
#   release   NAME
#
#   insert_rows XVALUES
#   delete_rows XVALUES
#
proc savepoint {zName} {
  catch { db eval "SAVEPOINT $zName" }
  lappend ::lSavepoint [list $zName [array get ::aEntry]]
}

proc rollback {zName} {
  catch { db eval "ROLLBACK TO $zName" }
  for {set i [expr {[llength $::lSavepoint]-1}]} {$i>=0} {incr i -1} {
    set zSavepoint [lindex $::lSavepoint $i 0]
    if {$zSavepoint eq $zName} {
      unset -nocomplain ::aEntry
      array set ::aEntry [lindex $::lSavepoint $i 1]


      if {$i+1 < [llength $::lSavepoint]} {
        set ::lSavepoint [lreplace $::lSavepoint [expr $i+1] end]
      }
      break
    }
  }
}

proc release {zName} {
  catch { db eval "RELEASE $zName" }
  for {set i [expr {[llength $::lSavepoint]-1}]} {$i>=0} {incr i -1} {
    set zSavepoint [lindex $::lSavepoint $i 0]
    if {$zSavepoint eq $zName} {
      set ::lSavepoint [lreplace $::lSavepoint $i end]
      break
    }
  }
}

proc insert_rows {lX} {
  foreach x $lX {
    set y [x_to_y $x]

    # Update database [db]
    db eval {INSERT OR REPLACE INTO t1 VALUES($x, $y)}

    # Update the Tcl database.
    set ::aEntry($x) $y
  }
}

proc delete_rows {lX} {
  foreach x $lX {
    # Update database [db]
    db eval {DELETE FROM t1 WHERE x = $x}

    # Update the Tcl database.
    unset -nocomplain ::aEntry($x)
  }
}
#-------------------------------------------------------------------------

#-------------------------------------------------------------------------
# Proc to compare database content with the in-memory representation.
#
#   checkdb
#
proc checkdb {} {
  set nEntry [db one {SELECT count(*) FROM t1}]
  set nEntry2 [array size ::aEntry]
  if {$nEntry != $nEntry2} {
    error "$nEntry entries in database, $nEntry2 entries in array"
  }
  db eval {SELECT x, y FROM t1} {
    if {![info exists ::aEntry($x)]} {
      error "Entry $x exists in database, but not in array"
    }
    if {$::aEntry($x) ne $y} {
      error "Entry $x is set to {$y} in database, {$::aEntry($x)} in array"
    }
  }

  db eval { PRAGMA integrity_check }
}
#-------------------------------------------------------------------------

#-------------------------------------------------------------------------
# Proc to return random set of x values.
#
#   random_integers
#
proc random_integers {nRes nRange} {
  set ret [list]
  for {set i 0} {$i<$nRes} {incr i} {
    lappend ret [expr int(rand()*$nRange)]
  }
  return $ret
} 
#-------------------------------------------------------------------------

db eval { PRAGMA cache_size = 10 }
expr srand(0)

proc database_op {} {
  set i [expr int(rand()*2)] 
  if {$i==0} {
    insert_rows [random_integers 100 1000]
  }
  if {$i==1} {
    delete_rows [random_integers 100 1000]
    set i [expr int(rand()*3)] 
    if {$i==0} {
      db eval {PRAGMA incremental_vacuum}
    }
  }
}

proc savepoint_op {} {
  set names {one two three four five}
  set cmds  {savepoint savepoint savepoint savepoint release rollback}

  set C [lindex $cmds [expr int(rand()*6)]]
  set N [lindex $names [expr int(rand()*5)]]

  $C $N
  return ok
}

do_test savepoint6-2.1 {
  savepoint one
  insert_rows [random_integers 100 1000]
  release one
  checkdb
} {ok}

for {set i 0} {$i < 1000} {incr i} {
  do_test savepoint6-3.$i.1 {
    savepoint_op
  } {ok}

  do_test savepoint6-3.$i.2 {
    database_op
    database_op
    checkdb
  } {ok}
}

unset -nocomplain ::lSavepoint
unset -nocomplain ::aEntry

finish_test