SQLite

# 2008 January 8
#
# 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.
#
#***********************************************************************
#
# This file contains additional tests to verify that SQLite database
# file survive a power loss or OS crash.
#
# $Id: crash4.test,v 1.1 2008/01/08 16:03:50 drh Exp $

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

ifcapable !crashtest {
  finish_test
  return
}

# Generate a checksum based on the contents of the database. If the
# checksum of two databases is the same, and the integrity-check passes
# for both, the two databases are identical.
#
proc cksum {db} {
  set ret [list]
  ifcapable tempdb {
    set sql {
      SELECT name FROM sqlite_master WHERE type = 'table' UNION
      SELECT name FROM sqlite_temp_master WHERE type = 'table' UNION
      SELECT 'sqlite_master' UNION
      SELECT 'sqlite_temp_master'
    }
  } else {
    set sql {
      SELECT name FROM sqlite_master WHERE type = 'table' UNION
      SELECT 'sqlite_master'
    }
  }
  set tbllist [$db eval $sql]
  set txt {}
  foreach tbl $tbllist {
    append txt [$db eval "SELECT * FROM $tbl"]
  }
  return [md5 $txt]
}

# A sequence of SQL commands:
#
set sql_cmd_list {
  {CREATE TABLE a(id INTEGER, name CHAR(50))}
  {INSERT INTO a(id,name) VALUES(1,'one')}
  {INSERT INTO a(id,name) VALUES(2,'two')}
  {INSERT INTO a(id,name) VALUES(3,'three')}
  {INSERT INTO a(id,name) VALUES(4,'four')}
  {INSERT INTO a(id,name) VALUES(5,'five')}
  {INSERT INTO a(id,name) VALUES(6,'six')}
  {INSERT INTO a(id,name) VALUES(7,'seven')}
  {INSERT INTO a(id,name) VALUES(8,'eight')}
  {INSERT INTO a(id,name) VALUES(9,'nine')}
  {INSERT INTO a(id,name) VALUES(10,'ten')}
  {UPDATE A SET name='new text for row 3' WHERE id=3}
}

# Assume that a database is created by evaluating the SQL statements
# in $sql_cmd_list.  Compute a set of checksums that capture the state
# of the database after each statement.  Also include a checksum for
# the state of the database prior to any of these statements.
#
set crash4_cksum_set {}
lappend crash4_cksum_set [cksum db]
foreach cmd $sql_cmd_list {
  db eval $cmd
  lappend crash4_cksum_set [cksum db]
}

# Run the sequence of SQL statements shown above repeatedly.
# Close and reopen the database right before the UPDATE statement.
# On each repetition, introduce database corruption typical of
# what might be seen in a power loss or OS crash.  
#
# Slowly increase the delay before the crash, repeating the test
# over and over.  Stop testing when the entire sequence of SQL
# statements runs to completing without hitting the crash.
#
for {set cnt 1; set fin 0} {!$fin} {incr cnt} {
  db close
  file delete -force test.db test.db-journal
  do_test crash4-1.$cnt.1 {
    set seed [expr {int(abs(rand()*10000))}]
    set delay [expr {int($cnt/50)+1}]
    set file [expr {($cnt&1)?"test.db":"test.db-journal"}]
    set c [crashsql -delay $delay -file $file -seed $seed -tclbody {
      db eval {CREATE TABLE a(id INTEGER, name CHAR(50))}
      db eval {INSERT INTO a(id,name) VALUES(1,'one')}
      db eval {INSERT INTO a(id,name) VALUES(2,'two')}
      db eval {INSERT INTO a(id,name) VALUES(3,'three')}
      db eval {INSERT INTO a(id,name) VALUES(4,'four')}
      db eval {INSERT INTO a(id,name) VALUES(5,'five')}
      db eval {INSERT INTO a(id,name) VALUES(6,'six')}
      db eval {INSERT INTO a(id,name) VALUES(7,'seven')}
      db eval {INSERT INTO a(id,name) VALUES(8,'eight')}
      db eval {INSERT INTO a(id,name) VALUES(9,'nine')}
      db eval {INSERT INTO a(id,name) VALUES(10,'ten')}
      db close
      sqlite3 db test.db
      db eval {UPDATE A SET name='new text for row 3' WHERE id=3}
      db close
    } {}]
    if {$c==[list 0 {}]} {
      set ::fin 1
      set c [list 1 {child process exited abnormally}]
    }
    set c
  } {1 {child process exited abnormally}}
  sqlite3 db test.db
  integrity_check crash4-1.$cnt.2
  do_test crash4-1.$cnt.3 {
    set x [lsearch $::crash4_cksum_set [cksum db]]
    expr {$x>=0}
  } {1}
}

finish_test

# 2001 September 15
#
# 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.
#
#***********************************************************************
# This file implements some common TCL routines used for regression
# testing the SQLite library
#
# $Id: tester.tcl,v 1.98 2008/01/08 16:03:50 drh Exp $


set tcl_precision 15
set sqlite_pending_byte 0x0010000

# 
# Check the command-line arguments for a default soft-heap-limit.

  if {$::tcl_platform(platform)!="unix"} {
    error "crashsql should only be used on unix"
  }

  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"

  puts $f {btree_set_cache_size $bt 10}
  if {$prngseed} {
    set seed [expr {$prngseed%10007+1}]
    # puts seed=$seed
    puts $f "db eval {SELECT randomblob($seed)}"
  }

  if {[string length $tclbody]>0} {
    puts $f $tclbody
  }
  if {[string length $sql]>0} {
    puts $f "db eval {"
    puts $f   "$sql"
    puts $f "}"
  }
  close $f

  set r [catch {
    exec [info nameofexec] crash.tcl >@stdout
  } msg]
  lappend r $msg
}