database/sqlite
1
0
Fork 0
mirror of https://github.com/sqlite/sqlite.git synced 2025-08-08 14:02:16 +03:00
Code Activity

Many problems fixed. Many problems yet to go. (CVS 242)

Browse Source 
FossilOrigin-Name: 62c7bd11bcf6438cdcbf66fa67a2bf4ab9d1664d
This commit is contained in:
drh
2001-09-13 21:53:09 +00:00
parent d78eeee1f2
commit 5edc31243e
18 changed files with 310 additions and 456 deletions
Download Patch File Download Diff File Expand all files Collapse all files

56
test/tester.tcl
View File

@@ -23,7 +23,7 @@
# This file implements some common TCL routines used for regression
# testing the SQLite library
#
# $Id: tester.tcl,v 1.15 2001/04/11 14:28:43 drh Exp $
# $Id: tester.tcl,v 1.16 2001/09/13 21:53:10 drh Exp $
# Make sure tclsqlite was compiled correctly. Abort now with an
# error message if not.
@@ -54,28 +54,9 @@ if {[sqlite -tcl-uses-utf]} {
# Create a test database
#
if {![info exists dbprefix]} {
if {[info exists env(SQLITE_PREFIX)]} {
set dbprefix $env(SQLITE_PREFIX):
} else {
set dbprefix "gdbm:"
}
}
switch $dbprefix {
gdbm: {
foreach f [glob -nocomplain testdb/*] {
catch {file delete -force $f}
}
if {[catch {file delete -force testdb}]} {
exec rm -rf testdb
}
file mkdir testdb
}
memory: {
# do nothing
}
}
sqlite db ${dbprefix}testdb
file delete -force ./test.db
file delete -force ./test.db-journal
sqlite db ./test.db
# Abort early if this script has been run before.
#
@@ -109,14 +90,16 @@ proc do_test {name cmd expected} {
}
if {!$go} return
incr nTest
puts -nonewline $::dbprefix$name...
puts -nonewline $name...
flush stdout
if {[catch {uplevel #0 "$cmd;\n"} result]} {
puts "\nError: $result"
incr nErr
if {$nErr>10} {puts "*** Giving up..."; exit 1}
} elseif {[string compare $result $expected]} {
puts "\nExpected: \[$expected\]\n Got: \[$result\]"
incr nErr
if {$nErr>10} {puts "*** Giving up..."; exit 1}
} else {
puts " Ok"
}
@@ -144,7 +127,7 @@ proc do_probtest {name cmd expected} {
}
if {!$go} return
incr nTest
puts -nonewline $::dbprefix$name...
puts -nonewline $name...
flush stdout
if {[catch {uplevel #0 "$cmd;\n"} result]} {
puts "\nError: $result"
@@ -160,29 +143,6 @@ proc do_probtest {name cmd expected} {
}
}
# Skip a test based on the dbprefix
#
proc skipif {args} {
foreach a $args {
if {$::dbprefix==$a} {
set ::skip_test 1
return
}
}
}
# Run the next test only if the dbprefix is among the listed arguments
#
proc testif {args} {
foreach a $args {
if {$::dbprefix==$a} {
set ::skip_test 0
return
}
}
set ::skip_test 1
}
# The procedure uses the special "sqlite_malloc_stat" command
# (which is only available if SQLite is compiled with -DMEMORY_DEBUG=1)
# to see how many malloc()s have not been free()ed. The number