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:
@ -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"
|
||||
|
||||
|
Reference in New Issue
Block a user