1
0
mirror of https://github.com/sqlite/sqlite.git synced 2025-07-30 19:03:16 +03:00

Modifications to crash-test infrastructure. (CVS 3695)

FossilOrigin-Name: c4be8d9949fc7b5e1bed757423c5195f38069048
This commit is contained in:
danielk1977
2007-03-17 10:26:59 +00:00
parent 933bbd6c8d
commit 59a33f98d6
11 changed files with 114 additions and 64 deletions

View File

@ -11,7 +11,7 @@
# This file implements some common TCL routines used for regression
# testing the SQLite library
#
# $Id: tester.tcl,v 1.74 2007/03/17 07:22:43 danielk1977 Exp $
# $Id: tester.tcl,v 1.75 2007/03/17 10:26:59 danielk1977 Exp $
# Make sure tclsqlite3 was compiled correctly. Abort now with an
# error message if not.
@ -309,14 +309,37 @@ proc ifcapable {expr code {else ""} {elsecode ""}} {
# error message. This is "child process exited abnormally" if the crash
# occured.
#
proc crashsql {crashdelay crashfile sql} {
# crashsql -delay CRASHDELAY -file CRASHFILE ?-blocksize BLOCKSIZE $sql
#
proc crashsql {args} {
if {$::tcl_platform(platform)!="unix"} {
error "crashsql should only be used on unix"
}
set blocksize ""
set crashdelay 1
set crashfile ""
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 -file]==0} {set crashfile $z2} \
elseif {$n>1 && [string first $z -blocksize]==0} {set blocksize $z2} \
else { error "Unrecognized option: $z" }
}
if {$crashfile eq ""} {
error "Compulsory option -file missing"
}
set cfile [file join [pwd] $crashfile]
set f [open crash.tcl w]
puts $f "sqlite3_crashparams $crashdelay $cfile"
puts $f "sqlite3_crashparams $crashdelay $cfile $blocksize"
puts $f "set sqlite_pending_byte $::sqlite_pending_byte"
puts $f "sqlite3 db test.db"