blob: cc7f913778bff138838ecde87e8d58cf5cef751a [file] [log] [blame]
drhb19a2bc2001-09-16 00:13:26 +00001# 2001 September 15
drh348784e2000-05-29 20:41:49 +00002#
drhb19a2bc2001-09-16 00:13:26 +00003# The author disclaims copyright to this source code. In place of
4# a legal notice, here is a blessing:
drh348784e2000-05-29 20:41:49 +00005#
drhb19a2bc2001-09-16 00:13:26 +00006# May you do good and not evil.
7# May you find forgiveness for yourself and forgive others.
8# May you share freely, never taking more than you give.
drh348784e2000-05-29 20:41:49 +00009#
10#***********************************************************************
11# This file implements some common TCL routines used for regression
12# testing the SQLite library
13#
drhbb77b752009-04-09 01:23:49 +000014# $Id: tester.tcl,v 1.143 2009/04/09 01:23:49 drh Exp $
drhfbc3eab2001-04-06 16:13:42 +000015
danc1a60c52010-06-07 14:28:16 +000016#-------------------------------------------------------------------------
mistachkin1d406e02013-08-29 01:09:14 +000017# The commands provided by the code in this file to help with creating
danc1a60c52010-06-07 14:28:16 +000018# test cases are as follows:
drh8359d8c2008-03-29 11:00:54 +000019#
danc1a60c52010-06-07 14:28:16 +000020# Commands to manipulate the db and the file-system at a high level:
drh8359d8c2008-03-29 11:00:54 +000021#
mistachkinc5484652012-03-05 22:52:33 +000022# is_relative_file
mistachkin4a41f342012-03-06 03:00:49 +000023# test_pwd
mistachkinf8a78462012-03-08 20:00:36 +000024# get_pwd
danc1a60c52010-06-07 14:28:16 +000025# copy_file FROM TO
mistachkinfda06be2011-08-02 00:57:34 +000026# delete_file FILENAME
dan67340072011-04-16 19:23:10 +000027# drop_all_tables ?DB?
dand05a7142016-08-02 17:07:51 +000028# drop_all_indexes ?DB?
mistachkinfda06be2011-08-02 00:57:34 +000029# forcecopy FROM TO
danc1a60c52010-06-07 14:28:16 +000030# forcedelete FILENAME
31#
32# Test the capability of the SQLite version built into the interpreter to
33# determine if a specific test can be run:
34#
mistachkinc60941f2012-09-13 01:51:02 +000035# capable EXPR
danc1a60c52010-06-07 14:28:16 +000036# ifcapable EXPR
37#
38# Calulate checksums based on database contents:
39#
40# dbcksum DB DBNAME
41# allcksum ?DB?
42# cksum ?DB?
43#
44# Commands to execute/explain SQL statements:
45#
mistachkin1d406e02013-08-29 01:09:14 +000046# memdbsql SQL
danc1a60c52010-06-07 14:28:16 +000047# stepsql DB SQL
48# execsql2 SQL
49# explain_no_trace SQL
50# explain SQL ?DB?
51# catchsql SQL ?DB?
52# execsql SQL ?DB?
53#
54# Commands to run test cases:
55#
56# do_ioerr_test TESTNAME ARGS...
57# crashsql ARGS...
58# integrity_check TESTNAME ?DB?
drh433dccf2013-02-09 15:37:11 +000059# verify_ex_errcode TESTNAME EXPECTED ?DB?
danc1a60c52010-06-07 14:28:16 +000060# do_test TESTNAME SCRIPT EXPECTED
dan153eda02010-06-21 07:45:47 +000061# do_execsql_test TESTNAME SQL EXPECTED
62# do_catchsql_test TESTNAME SQL EXPECTED
drh3c2aeae2014-01-24 14:37:44 +000063# do_timed_execsql_test TESTNAME SQL EXPECTED
danc1a60c52010-06-07 14:28:16 +000064#
dan430e74c2010-06-07 17:47:26 +000065# Commands providing a lower level interface to the global test counters:
danc1a60c52010-06-07 14:28:16 +000066#
67# set_test_counter COUNTER ?VALUE?
mistachkin6c3c1a02011-11-12 03:17:40 +000068# omit_test TESTNAME REASON ?APPEND?
danc1a60c52010-06-07 14:28:16 +000069# fail_test TESTNAME
70# incr_ntest
71#
72# Command run at the end of each test file:
73#
74# finish_test
75#
dan430e74c2010-06-07 17:47:26 +000076# Commands to help create test files that run with the "WAL" and other
77# permutations (see file permutations.test):
danc1a60c52010-06-07 14:28:16 +000078#
79# wal_is_wal_mode
80# wal_set_journal_mode ?DB?
81# wal_check_journal_mode TESTNAME?DB?
dan430e74c2010-06-07 17:47:26 +000082# permutation
dancb79e512010-08-06 13:50:07 +000083# presql
danc1a60c52010-06-07 14:28:16 +000084#
dan17c08232015-06-09 15:58:28 +000085# Command to test whether or not --verbose=1 was specified on the command
86# line (returns 0 for not-verbose, 1 for verbose and 2 for "verbose in the
87# output file only").
88#
89# verbose
90#
drh348784e2000-05-29 20:41:49 +000091
mistachkin1d406e02013-08-29 01:09:14 +000092# Set the precision of FP arithmatic used by the interpreter. And
danc1a60c52010-06-07 14:28:16 +000093# configure SQLite to take database file locks on the page that begins
94# 64KB into the database file instead of the one 1GB in. This means
95# the code that handles that special case can be tested without creating
96# very large database files.
97#
drh92febd92004-08-20 18:34:20 +000098set tcl_precision 15
drhc7a3bb92009-02-05 16:31:45 +000099sqlite3_test_control_pending_byte 0x0010000
drh92febd92004-08-20 18:34:20 +0000100
danc1a60c52010-06-07 14:28:16 +0000101
mistachkin1d406e02013-08-29 01:09:14 +0000102# If the pager codec is available, create a wrapper for the [sqlite3]
danc1a60c52010-06-07 14:28:16 +0000103# command that appends "-key {xyzzy}" to the command line. i.e. this:
drh3a7fb7c2007-08-10 16:41:08 +0000104#
danc1a60c52010-06-07 14:28:16 +0000105# sqlite3 db test.db
drh4a50aac2007-08-23 02:47:53 +0000106#
danc1a60c52010-06-07 14:28:16 +0000107# becomes
drh4a50aac2007-08-23 02:47:53 +0000108#
danc1a60c52010-06-07 14:28:16 +0000109# sqlite3 db test.db -key {xyzzy}
drh9eb9e262004-02-11 02:18:05 +0000110#
dan430e74c2010-06-07 17:47:26 +0000111if {[info command sqlite_orig]==""} {
drhef4ac8f2004-06-19 00:16:31 +0000112 rename sqlite3 sqlite_orig
113 proc sqlite3 {args} {
dan68928b62010-06-22 13:46:43 +0000114 if {[llength $args]>=2 && [string index [lindex $args 0] 0]!="-"} {
dan430e74c2010-06-07 17:47:26 +0000115 # This command is opening a new database connection.
116 #
117 if {[info exists ::G(perm:sqlite3_args)]} {
118 set args [concat $args $::G(perm:sqlite3_args)]
119 }
dan68928b62010-06-22 13:46:43 +0000120 if {[sqlite_orig -has-codec] && ![info exists ::do_not_use_codec]} {
dan430e74c2010-06-07 17:47:26 +0000121 lappend args -key {xyzzy}
122 }
123
dan3ccd20a2010-06-09 19:01:02 +0000124 set res [uplevel 1 sqlite_orig $args]
dan430e74c2010-06-07 17:47:26 +0000125 if {[info exists ::G(perm:presql)]} {
126 [lindex $args 0] eval $::G(perm:presql)
127 }
dan1ce1b4a2010-12-07 14:32:28 +0000128 if {[info exists ::G(perm:dbconfig)]} {
129 set ::dbhandle [lindex $args 0]
130 uplevel #0 $::G(perm:dbconfig)
131 }
dan3ccd20a2010-06-09 19:01:02 +0000132 set res
dan430e74c2010-06-07 17:47:26 +0000133 } else {
mistachkin1d406e02013-08-29 01:09:14 +0000134 # This command is not opening a new database connection. Pass the
mistachkin48864df2013-03-21 21:20:32 +0000135 # arguments through to the C implementation as the are.
dan430e74c2010-06-07 17:47:26 +0000136 #
137 uplevel 1 sqlite_orig $args
drh9eb9e262004-02-11 02:18:05 +0000138 }
drh9eb9e262004-02-11 02:18:05 +0000139 }
140}
141
mistachkinfda06be2011-08-02 00:57:34 +0000142proc getFileRetries {} {
143 if {![info exists ::G(file-retries)]} {
144 #
145 # NOTE: Return the default number of retries for [file] operations. A
146 # value of zero or less here means "disabled".
147 #
mistachkinc60941f2012-09-13 01:51:02 +0000148 return [expr {$::tcl_platform(platform) eq "windows" ? 50 : 0}]
mistachkinfda06be2011-08-02 00:57:34 +0000149 }
150 return $::G(file-retries)
151}
152
153proc getFileRetryDelay {} {
154 if {![info exists ::G(file-retry-delay)]} {
155 #
156 # NOTE: Return the default number of milliseconds to wait when retrying
157 # failed [file] operations. A value of zero or less means "do not
158 # wait".
159 #
160 return 100; # TODO: Good default?
161 }
162 return $::G(file-retry-delay)
163}
164
mistachkinf8a78462012-03-08 20:00:36 +0000165# Return the string representing the name of the current directory. On
166# Windows, the result is "normalized" to whatever our parent command shell
167# is using to prevent case-mismatch issues.
168#
169proc get_pwd {} {
170 if {$::tcl_platform(platform) eq "windows"} {
mistachkin533b8f62012-03-08 20:28:31 +0000171 #
172 # NOTE: Cannot use [file normalize] here because it would alter the
173 # case of the result to what Tcl considers canonical, which would
174 # defeat the purpose of this procedure.
175 #
176 return [string map [list \\ /] \
177 [string trim [exec -- $::env(ComSpec) /c echo %CD%]]]
mistachkinf8a78462012-03-08 20:00:36 +0000178 } else {
179 return [pwd]
180 }
181}
182
mistachkinfda06be2011-08-02 00:57:34 +0000183# Copy file $from into $to. This is used because some versions of
184# TCL for windows (notably the 8.4.1 binary package shipped with the
185# current mingw release) have a broken "file copy" command.
186#
187proc copy_file {from to} {
188 do_copy_file false $from $to
189}
190
191proc forcecopy {from to} {
192 do_copy_file true $from $to
193}
194
195proc do_copy_file {force from to} {
196 set nRetry [getFileRetries] ;# Maximum number of retries.
197 set nDelay [getFileRetryDelay] ;# Delay in ms before retrying.
198
199 # On windows, sometimes even a [file copy -force] can fail. The cause is
200 # usually "tag-alongs" - programs like anti-virus software, automatic backup
201 # tools and various explorer extensions that keep a file open a little longer
202 # than we expect, causing the delete to fail.
203 #
204 # The solution is to wait a short amount of time before retrying the copy.
205 #
206 if {$nRetry > 0} {
207 for {set i 0} {$i<$nRetry} {incr i} {
208 set rc [catch {
209 if {$force} {
210 file copy -force $from $to
211 } else {
212 file copy $from $to
213 }
214 } msg]
215 if {$rc==0} break
216 if {$nDelay > 0} { after $nDelay }
217 }
218 if {$rc} { error $msg }
219 } else {
220 if {$force} {
221 file copy -force $from $to
222 } else {
223 file copy $from $to
224 }
225 }
226}
227
mistachkinc5484652012-03-05 22:52:33 +0000228# Check if a file name is relative
229#
230proc is_relative_file { file } {
231 return [expr {[file pathtype $file] != "absolute"}]
232}
233
mistachkin4a41f342012-03-06 03:00:49 +0000234# If the VFS supports using the current directory, returns [pwd];
235# otherwise, it returns only the provided suffix string (which is
236# empty by default).
237#
238proc test_pwd { args } {
239 if {[llength $args] > 0} {
240 set suffix1 [lindex $args 0]
241 if {[llength $args] > 1} {
242 set suffix2 [lindex $args 1]
243 } else {
244 set suffix2 $suffix1
245 }
246 } else {
247 set suffix1 ""; set suffix2 ""
248 }
249 ifcapable curdir {
mistachkin6aa18c92012-03-08 20:22:42 +0000250 return "[get_pwd]$suffix1"
mistachkin4a41f342012-03-06 03:00:49 +0000251 } else {
252 return $suffix2
253 }
254}
255
mistachkinfda06be2011-08-02 00:57:34 +0000256# Delete a file or directory
257#
258proc delete_file {args} {
259 do_delete_file false {*}$args
260}
261
262proc forcedelete {args} {
263 do_delete_file true {*}$args
264}
265
266proc do_delete_file {force args} {
267 set nRetry [getFileRetries] ;# Maximum number of retries.
268 set nDelay [getFileRetryDelay] ;# Delay in ms before retrying.
269
270 foreach filename $args {
271 # On windows, sometimes even a [file delete -force] can fail just after
272 # a file is closed. The cause is usually "tag-alongs" - programs like
273 # anti-virus software, automatic backup tools and various explorer
274 # extensions that keep a file open a little longer than we expect, causing
275 # the delete to fail.
276 #
277 # The solution is to wait a short amount of time before retrying the
278 # delete.
279 #
280 if {$nRetry > 0} {
281 for {set i 0} {$i<$nRetry} {incr i} {
282 set rc [catch {
283 if {$force} {
284 file delete -force $filename
285 } else {
286 file delete $filename
287 }
288 } msg]
289 if {$rc==0} break
290 if {$nDelay > 0} { after $nDelay }
291 }
292 if {$rc} { error $msg }
293 } else {
294 if {$force} {
295 file delete -force $filename
296 } else {
297 file delete $filename
298 }
299 }
300 }
301}
302
mistachkin1d406e02013-08-29 01:09:14 +0000303if {$::tcl_platform(platform) eq "windows"} {
304 proc do_remove_win32_dir {args} {
305 set nRetry [getFileRetries] ;# Maximum number of retries.
306 set nDelay [getFileRetryDelay] ;# Delay in ms before retrying.
307
308 foreach dirName $args {
309 # On windows, sometimes even a [remove_win32_dir] can fail just after
310 # a directory is emptied. The cause is usually "tag-alongs" - programs
311 # like anti-virus software, automatic backup tools and various explorer
312 # extensions that keep a file open a little longer than we expect,
313 # causing the delete to fail.
314 #
315 # The solution is to wait a short amount of time before retrying the
316 # removal.
317 #
318 if {$nRetry > 0} {
319 for {set i 0} {$i < $nRetry} {incr i} {
320 set rc [catch {
321 remove_win32_dir $dirName
322 } msg]
323 if {$rc == 0} break
324 if {$nDelay > 0} { after $nDelay }
325 }
326 if {$rc} { error $msg }
327 } else {
328 remove_win32_dir $dirName
329 }
330 }
331 }
332
333 proc do_delete_win32_file {args} {
334 set nRetry [getFileRetries] ;# Maximum number of retries.
335 set nDelay [getFileRetryDelay] ;# Delay in ms before retrying.
336
337 foreach fileName $args {
338 # On windows, sometimes even a [delete_win32_file] can fail just after
339 # a file is closed. The cause is usually "tag-alongs" - programs like
340 # anti-virus software, automatic backup tools and various explorer
341 # extensions that keep a file open a little longer than we expect,
342 # causing the delete to fail.
343 #
344 # The solution is to wait a short amount of time before retrying the
345 # delete.
346 #
347 if {$nRetry > 0} {
348 for {set i 0} {$i < $nRetry} {incr i} {
349 set rc [catch {
350 delete_win32_file $fileName
351 } msg]
352 if {$rc == 0} break
353 if {$nDelay > 0} { after $nDelay }
354 }
355 if {$rc} { error $msg }
356 } else {
357 delete_win32_file $fileName
358 }
359 }
360 }
361}
362
dancb354602010-07-08 09:44:42 +0000363proc execpresql {handle args} {
364 trace remove execution $handle enter [list execpresql $handle]
365 if {[info exists ::G(perm:presql)]} {
366 $handle eval $::G(perm:presql)
367 }
368}
369
dan68928b62010-06-22 13:46:43 +0000370# This command should be called after loading tester.tcl from within
371# all test scripts that are incompatible with encryption codecs.
372#
373proc do_not_use_codec {} {
374 set ::do_not_use_codec 1
375 reset_db
376}
drh422dded2016-07-25 16:10:43 +0000377unset -nocomplain do_not_use_codec
dan68928b62010-06-22 13:46:43 +0000378
drhaf3906a2016-03-14 17:05:04 +0000379# Return true if the "reserved_bytes" integer on database files is non-zero.
380#
381proc nonzero_reserved_bytes {} {
382 return [sqlite3 -has-codec]
383}
384
drh4b7b1c92016-02-15 19:38:17 +0000385# Print a HELP message and exit
386#
387proc print_help_and_quit {} {
388 puts {Options:
389 --pause Wait for user input before continuing
390 --soft-heap-limit=N Set the soft-heap-limit to N
drh31999c52019-11-14 17:46:32 +0000391 --hard-heap-limit=N Set the hard-heap-limit to N
drh4b7b1c92016-02-15 19:38:17 +0000392 --maxerror=N Quit after N errors
393 --verbose=(0|1) Control the amount of output. Default '1'
394 --output=FILE set --verbose=2 and output to FILE. Implies -q
395 -q Shorthand for --verbose=0
396 --help This message
397}
398 exit 1
399}
400
dan430e74c2010-06-07 17:47:26 +0000401# The following block only runs the first time this file is sourced. It
402# does not run in slave interpreters (since the ::cmdlinearg array is
403# populated before the test script is run in slave interpreters).
drhbec2bf42000-05-29 23:48:22 +0000404#
danc1a60c52010-06-07 14:28:16 +0000405if {[info exists cmdlinearg]==0} {
406
mistachkin1d406e02013-08-29 01:09:14 +0000407 # Parse any options specified in the $argv array. This script accepts the
408 # following options:
danc1a60c52010-06-07 14:28:16 +0000409 #
410 # --pause
411 # --soft-heap-limit=NN
drh31999c52019-11-14 17:46:32 +0000412 # --hard-heap-limit=NN
danc1a60c52010-06-07 14:28:16 +0000413 # --maxerror=NN
414 # --malloctrace=N
415 # --backtrace=N
416 # --binarylog=N
dan0626dfc2010-06-15 06:56:37 +0000417 # --soak=N
mistachkinfda06be2011-08-02 00:57:34 +0000418 # --file-retries=N
419 # --file-retry-delay=N
dan6a64d672011-04-04 15:38:16 +0000420 # --start=[$permutation:]$testfile
mistachkin6c3c1a02011-11-12 03:17:40 +0000421 # --match=$pattern
dan17c08232015-06-09 15:58:28 +0000422 # --verbose=$val
423 # --output=$filename
drhd5704a82016-03-14 13:42:29 +0000424 # -q Reduce output
425 # --testdir=$dir Run tests in subdirectory $dir
dan17c08232015-06-09 15:58:28 +0000426 # --help
danc1a60c52010-06-07 14:28:16 +0000427 #
428 set cmdlinearg(soft-heap-limit) 0
drh31999c52019-11-14 17:46:32 +0000429 set cmdlinearg(hard-heap-limit) 0
danc1a60c52010-06-07 14:28:16 +0000430 set cmdlinearg(maxerror) 1000
431 set cmdlinearg(malloctrace) 0
432 set cmdlinearg(backtrace) 10
433 set cmdlinearg(binarylog) 0
dan0626dfc2010-06-15 06:56:37 +0000434 set cmdlinearg(soak) 0
mistachkinfda06be2011-08-02 00:57:34 +0000435 set cmdlinearg(file-retries) 0
436 set cmdlinearg(file-retry-delay) 0
mistachkin6c3c1a02011-11-12 03:17:40 +0000437 set cmdlinearg(start) ""
438 set cmdlinearg(match) ""
dan17c08232015-06-09 15:58:28 +0000439 set cmdlinearg(verbose) ""
440 set cmdlinearg(output) ""
drhd5704a82016-03-14 13:42:29 +0000441 set cmdlinearg(testdir) "testdir"
danc1a60c52010-06-07 14:28:16 +0000442
443 set leftover [list]
444 foreach a $argv {
445 switch -regexp -- $a {
446 {^-+pause$} {
mistachkin1d406e02013-08-29 01:09:14 +0000447 # Wait for user input before continuing. This is to give the user an
danc1a60c52010-06-07 14:28:16 +0000448 # opportunity to connect profiling tools to the process.
449 puts -nonewline "Press RETURN to begin..."
450 flush stdout
451 gets stdin
452 }
453 {^-+soft-heap-limit=.+$} {
454 foreach {dummy cmdlinearg(soft-heap-limit)} [split $a =] break
455 }
drh31999c52019-11-14 17:46:32 +0000456 {^-+hard-heap-limit=.+$} {
457 foreach {dummy cmdlinearg(hard-heap-limit)} [split $a =] break
458 }
danc1a60c52010-06-07 14:28:16 +0000459 {^-+maxerror=.+$} {
460 foreach {dummy cmdlinearg(maxerror)} [split $a =] break
461 }
462 {^-+malloctrace=.+$} {
463 foreach {dummy cmdlinearg(malloctrace)} [split $a =] break
464 if {$cmdlinearg(malloctrace)} {
dan253c6ee2018-09-18 17:00:06 +0000465 if {0==$::sqlite_options(memdebug)} {
466 set err "Error: --malloctrace=1 requires an SQLITE_MEMDEBUG build"
467 puts stderr $err
468 exit 1
469 }
danc1a60c52010-06-07 14:28:16 +0000470 sqlite3_memdebug_log start
471 }
472 }
473 {^-+backtrace=.+$} {
474 foreach {dummy cmdlinearg(backtrace)} [split $a =] break
dan2a86c192017-01-25 17:44:13 +0000475 sqlite3_memdebug_backtrace $cmdlinearg(backtrace)
danc1a60c52010-06-07 14:28:16 +0000476 }
danc1a60c52010-06-07 14:28:16 +0000477 {^-+binarylog=.+$} {
478 foreach {dummy cmdlinearg(binarylog)} [split $a =] break
drhe500f652016-03-14 14:59:35 +0000479 set cmdlinearg(binarylog) [file normalize $cmdlinearg(binarylog)]
danc1a60c52010-06-07 14:28:16 +0000480 }
dan0626dfc2010-06-15 06:56:37 +0000481 {^-+soak=.+$} {
482 foreach {dummy cmdlinearg(soak)} [split $a =] break
483 set ::G(issoak) $cmdlinearg(soak)
484 }
mistachkinfda06be2011-08-02 00:57:34 +0000485 {^-+file-retries=.+$} {
486 foreach {dummy cmdlinearg(file-retries)} [split $a =] break
487 set ::G(file-retries) $cmdlinearg(file-retries)
488 }
489 {^-+file-retry-delay=.+$} {
490 foreach {dummy cmdlinearg(file-retry-delay)} [split $a =] break
491 set ::G(file-retry-delay) $cmdlinearg(file-retry-delay)
492 }
dan6a64d672011-04-04 15:38:16 +0000493 {^-+start=.+$} {
494 foreach {dummy cmdlinearg(start)} [split $a =] break
495
496 set ::G(start:file) $cmdlinearg(start)
497 if {[regexp {(.*):(.*)} $cmdlinearg(start) -> s.perm s.file]} {
498 set ::G(start:permutation) ${s.perm}
499 set ::G(start:file) ${s.file}
500 }
501 if {$::G(start:file) == ""} {unset ::G(start:file)}
502 }
mistachkin6c3c1a02011-11-12 03:17:40 +0000503 {^-+match=.+$} {
504 foreach {dummy cmdlinearg(match)} [split $a =] break
505
506 set ::G(match) $cmdlinearg(match)
507 if {$::G(match) == ""} {unset ::G(match)}
508 }
dan17c08232015-06-09 15:58:28 +0000509
510 {^-+output=.+$} {
511 foreach {dummy cmdlinearg(output)} [split $a =] break
drhe500f652016-03-14 14:59:35 +0000512 set cmdlinearg(output) [file normalize $cmdlinearg(output)]
dan17c08232015-06-09 15:58:28 +0000513 if {$cmdlinearg(verbose)==""} {
514 set cmdlinearg(verbose) 2
515 }
516 }
517 {^-+verbose=.+$} {
518 foreach {dummy cmdlinearg(verbose)} [split $a =] break
519 if {$cmdlinearg(verbose)=="file"} {
520 set cmdlinearg(verbose) 2
521 } elseif {[string is boolean -strict $cmdlinearg(verbose)]==0} {
522 error "option --verbose= must be set to a boolean or to \"file\""
523 }
524 }
drhd5704a82016-03-14 13:42:29 +0000525 {^-+testdir=.*$} {
526 foreach {dummy cmdlinearg(testdir)} [split $a =] break
527 }
drh4b7b1c92016-02-15 19:38:17 +0000528 {.*help.*} {
529 print_help_and_quit
530 }
531 {^-q$} {
532 set cmdlinearg(output) test-out.txt
533 set cmdlinearg(verbose) 2
534 }
dan17c08232015-06-09 15:58:28 +0000535
danc1a60c52010-06-07 14:28:16 +0000536 default {
dan40cf36f2016-04-30 19:23:10 +0000537 if {[file tail $a]==$a} {
538 lappend leftover $a
539 } else {
540 lappend leftover [file normalize $a]
541 }
danc1a60c52010-06-07 14:28:16 +0000542 }
543 }
544 }
drhbea14132016-03-14 14:28:43 +0000545 set testdir [file normalize $testdir]
drhd5704a82016-03-14 13:42:29 +0000546 set cmdlinearg(TESTFIXTURE_HOME) [pwd]
drhaf3906a2016-03-14 17:05:04 +0000547 set cmdlinearg(INFO_SCRIPT) [file normalize [info script]]
drhbea14132016-03-14 14:28:43 +0000548 set argv0 [file normalize $argv0]
drhd5704a82016-03-14 13:42:29 +0000549 if {$cmdlinearg(testdir)!=""} {
550 file mkdir $cmdlinearg(testdir)
551 cd $cmdlinearg(testdir)
552 }
danc1a60c52010-06-07 14:28:16 +0000553 set argv $leftover
554
dan430e74c2010-06-07 17:47:26 +0000555 # Install the malloc layer used to inject OOM errors. And the 'automatic'
556 # extensions. This only needs to be done once for the process.
557 #
mistachkin1d406e02013-08-29 01:09:14 +0000558 sqlite3_shutdown
559 install_malloc_faultsim 1
danielk1977f7b9d662008-06-23 18:49:43 +0000560 sqlite3_initialize
drhbb77b752009-04-09 01:23:49 +0000561 autoinstall_test_functions
danc1a60c52010-06-07 14:28:16 +0000562
dan430e74c2010-06-07 17:47:26 +0000563 # If the --binarylog option was specified, create the logging VFS. This
564 # call installs the new VFS as the default for all SQLite connections.
565 #
danc1a60c52010-06-07 14:28:16 +0000566 if {$cmdlinearg(binarylog)} {
danfbefb892010-05-12 19:02:35 +0000567 vfslog new binarylog {} vfslog.bin
danc1a60c52010-06-07 14:28:16 +0000568 }
569
570 # Set the backtrace depth, if malloc tracing is enabled.
571 #
572 if {$cmdlinearg(malloctrace)} {
573 sqlite3_memdebug_backtrace $cmdlinearg(backtrace)
danielk1977185eac92008-07-12 15:55:54 +0000574 }
dan17c08232015-06-09 15:58:28 +0000575
576 if {$cmdlinearg(output)!=""} {
577 puts "Copying output to file $cmdlinearg(output)"
578 set ::G(output_fd) [open $cmdlinearg(output) w]
579 fconfigure $::G(output_fd) -buffering line
580 }
581
582 if {$cmdlinearg(verbose)==""} {
583 set cmdlinearg(verbose) 1
584 }
dan1d07f1d2019-04-01 17:24:20 +0000585
586 if {[info commands vdbe_coverage]!=""} {
587 vdbe_coverage start
588 }
danielk1977f7b9d662008-06-23 18:49:43 +0000589}
danielk197703ba3fa2009-01-09 10:49:14 +0000590
danc1a60c52010-06-07 14:28:16 +0000591# Update the soft-heap-limit each time this script is run. In that
592# way if an individual test file changes the soft-heap-limit, it
593# will be reset at the start of the next test file.
594#
drh31999c52019-11-14 17:46:32 +0000595sqlite3_soft_heap_limit64 $cmdlinearg(soft-heap-limit)
596sqlite3_hard_heap_limit64 $cmdlinearg(hard-heap-limit)
danc1a60c52010-06-07 14:28:16 +0000597
598# Create a test database
599#
danielk197703ba3fa2009-01-09 10:49:14 +0000600proc reset_db {} {
601 catch {db close}
mistachkinfda06be2011-08-02 00:57:34 +0000602 forcedelete test.db
603 forcedelete test.db-journal
604 forcedelete test.db-wal
danielk197703ba3fa2009-01-09 10:49:14 +0000605 sqlite3 db ./test.db
606 set ::DB [sqlite3_connection_pointer db]
607 if {[info exists ::SETUP_SQL]} {
608 db eval $::SETUP_SQL
609 }
drhcd61c282002-03-06 22:01:34 +0000610}
danielk197703ba3fa2009-01-09 10:49:14 +0000611reset_db
drhbec2bf42000-05-29 23:48:22 +0000612
613# Abort early if this script has been run before.
614#
danc1a60c52010-06-07 14:28:16 +0000615if {[info exists TC(count)]} return
drhbec2bf42000-05-29 23:48:22 +0000616
drhce2198c2010-09-10 13:22:59 +0000617# Make sure memory statistics are enabled.
618#
619sqlite3_config_memstatus 1
620
danc1a60c52010-06-07 14:28:16 +0000621# Initialize the test counters and set up commands to access them.
622# Or, if this is a slave interpreter, set up aliases to write the
623# counters in the parent interpreter.
drhbec2bf42000-05-29 23:48:22 +0000624#
danc1a60c52010-06-07 14:28:16 +0000625if {0==[info exists ::SLAVE]} {
626 set TC(errors) 0
627 set TC(count) 0
628 set TC(fail_list) [list]
629 set TC(omit_list) [list]
drhcca17c32013-04-19 12:32:52 +0000630 set TC(warn_list) [list]
danc1a60c52010-06-07 14:28:16 +0000631
632 proc set_test_counter {counter args} {
633 if {[llength $args]} {
634 set ::TC($counter) [lindex $args 0]
635 }
636 set ::TC($counter)
637 }
drhb62c3352006-11-23 09:39:16 +0000638}
drh348784e2000-05-29 20:41:49 +0000639
drh521cc842008-04-15 02:36:33 +0000640# Record the fact that a sequence of tests were omitted.
641#
mistachkin6c3c1a02011-11-12 03:17:40 +0000642proc omit_test {name reason {append 1}} {
danc1a60c52010-06-07 14:28:16 +0000643 set omitList [set_test_counter omit_list]
mistachkin6c3c1a02011-11-12 03:17:40 +0000644 if {$append} {
645 lappend omitList [list $name $reason]
646 }
danc1a60c52010-06-07 14:28:16 +0000647 set_test_counter omit_list $omitList
drh521cc842008-04-15 02:36:33 +0000648}
649
danc1a60c52010-06-07 14:28:16 +0000650# Record the fact that a test failed.
651#
652proc fail_test {name} {
653 set f [set_test_counter fail_list]
654 lappend f $name
655 set_test_counter fail_list $f
656 set_test_counter errors [expr [set_test_counter errors] + 1]
657
658 set nFail [set_test_counter errors]
659 if {$nFail>=$::cmdlinearg(maxerror)} {
dan17c08232015-06-09 15:58:28 +0000660 output2 "*** Giving up..."
danc1a60c52010-06-07 14:28:16 +0000661 finalize_testing
662 }
663}
664
drhcca17c32013-04-19 12:32:52 +0000665# Remember a warning message to be displayed at the conclusion of all testing
666#
667proc warning {msg {append 1}} {
dan17c08232015-06-09 15:58:28 +0000668 output2 "Warning: $msg"
drhcca17c32013-04-19 12:32:52 +0000669 set warnList [set_test_counter warn_list]
670 if {$append} {
671 lappend warnList $msg
672 }
673 set_test_counter warn_list $warnList
674}
675
676
danc1a60c52010-06-07 14:28:16 +0000677# Increment the number of tests run
678#
679proc incr_ntest {} {
680 set_test_counter count [expr [set_test_counter count] + 1]
681}
682
dan17c08232015-06-09 15:58:28 +0000683# Return true if --verbose=1 was specified on the command line. Otherwise,
684# return false.
685#
686proc verbose {} {
687 return $::cmdlinearg(verbose)
688}
689
690# Use the following commands instead of [puts] for test output within
691# this file. Test scripts can still use regular [puts], which is directed
692# to stdout and, if one is open, the --output file.
693#
694# output1: output that should be printed if --verbose=1 was specified.
695# output2: output that should be printed unconditionally.
696# output2_if_no_verbose: output that should be printed only if --verbose=0.
697#
698proc output1 {args} {
699 set v [verbose]
700 if {$v==1} {
701 uplevel output2 $args
702 } elseif {$v==2} {
703 uplevel puts [lrange $args 0 end-1] $::G(output_fd) [lrange $args end end]
704 }
705}
706proc output2 {args} {
707 set nArg [llength $args]
708 uplevel puts $args
709}
710proc output2_if_no_verbose {args} {
711 set v [verbose]
712 if {$v==0} {
713 uplevel output2 $args
714 } elseif {$v==2} {
715 uplevel puts [lrange $args 0 end-1] stdout [lrange $args end end]
716 }
717}
718
719# Override the [puts] command so that if no channel is explicitly
720# specified the string is written to both stdout and to the file
721# specified by "--output=", if any.
722#
723proc puts_override {args} {
724 set nArg [llength $args]
725 if {$nArg==1 || ($nArg==2 && [string first [lindex $args 0] -nonewline]==0)} {
726 uplevel puts_original $args
727 if {[info exists ::G(output_fd)]} {
728 uplevel puts [lrange $args 0 end-1] $::G(output_fd) [lrange $args end end]
729 }
730 } else {
731 # A channel was explicitly specified.
732 uplevel puts_original $args
733 }
734}
735rename puts puts_original
736proc puts {args} { uplevel puts_override $args }
737
danc1a60c52010-06-07 14:28:16 +0000738
mistachkin1d406e02013-08-29 01:09:14 +0000739# Invoke the do_test procedure to run a single test
drh348784e2000-05-29 20:41:49 +0000740#
drhe39cd912016-07-09 17:47:01 +0000741# The $expected parameter is the expected result. The result is the return
742# value from the last TCL command in $cmd.
743#
744# Normally, $expected must match exactly. But if $expected is of the form
745# "/regexp/" then regular expression matching is used. If $expected is
746# "~/regexp/" then the regular expression must NOT match. If $expected is
747# of the form "#/value-list/" then each term in value-list must be numeric
748# and must approximately match the corresponding numeric term in $result.
749# Values must match within 10%. Or if the $expected term is A..B then the
750# $result term must be in between A and B.
751#
drh348784e2000-05-29 20:41:49 +0000752proc do_test {name cmd expected} {
danc1a60c52010-06-07 14:28:16 +0000753 global argv cmdlinearg
754
dan8c408002010-11-01 17:38:24 +0000755 fix_testname name
756
drh4a50aac2007-08-23 02:47:53 +0000757 sqlite3_memdebug_settitle $name
danc1a60c52010-06-07 14:28:16 +0000758
mistachkin1d406e02013-08-29 01:09:14 +0000759# if {[llength $argv]==0} {
dan92d516a2010-07-05 14:54:48 +0000760# set go 1
761# } else {
762# set go 0
763# foreach pattern $argv {
764# if {[string match $pattern $name]} {
765# set go 1
766# break
767# }
768# }
769# }
dan430e74c2010-06-07 17:47:26 +0000770
dand506de02010-07-03 13:59:01 +0000771 if {[info exists ::G(perm:prefix)]} {
772 set name "$::G(perm:prefix)$name"
dan430e74c2010-06-07 17:47:26 +0000773 }
774
danc1a60c52010-06-07 14:28:16 +0000775 incr_ntest
dan17c08232015-06-09 15:58:28 +0000776 output1 -nonewline $name...
drh348784e2000-05-29 20:41:49 +0000777 flush stdout
mistachkin6c3c1a02011-11-12 03:17:40 +0000778
779 if {![info exists ::G(match)] || [string match $::G(match) $name]} {
780 if {[catch {uplevel #0 "$cmd;\n"} result]} {
dan17c08232015-06-09 15:58:28 +0000781 output2_if_no_verbose -nonewline $name...
782 output2 "\nError: $result"
mistachkin6c3c1a02011-11-12 03:17:40 +0000783 fail_test $name
mistachkin6c3c1a02011-11-12 03:17:40 +0000784 } else {
dan00bd55e2020-03-20 20:54:28 +0000785 if {[permutation]=="maindbname"} {
786 set result [string map [list [string tolower ICECUBE] main] $result]
787 }
drhe39cd912016-07-09 17:47:01 +0000788 if {[regexp {^[~#]?/.*/$} $expected]} {
drh70bdcc72013-05-30 19:28:34 +0000789 # "expected" is of the form "/PATTERN/" then the result if correct if
790 # regular expression PATTERN matches the result. "~/PATTERN/" means
791 # the regular expression must not match.
drh3f17aef2012-04-27 01:08:02 +0000792 if {[string index $expected 0]=="~"} {
drhc2b23e72013-11-13 15:32:15 +0000793 set re [string range $expected 2 end-1]
794 if {[string index $re 0]=="*"} {
795 # If the regular expression begins with * then treat it as a glob instead
796 set ok [string match $re $result]
797 } else {
798 set re [string map {# {[-0-9.]+}} $re]
799 set ok [regexp $re $result]
800 }
801 set ok [expr {!$ok}]
drhe39cd912016-07-09 17:47:01 +0000802 } elseif {[string index $expected 0]=="#"} {
803 # Numeric range value comparison. Each term of the $result is matched
804 # against one term of $expect. Both $result and $expected terms must be
805 # numeric. The values must match within 10%. Or if $expected is of the
806 # form A..B then the $result term must be between A and B.
807 set e2 [string range $expected 2 end-1]
808 foreach i $result j $e2 {
809 if {[regexp {^(-?\d+)\.\.(-?\d)$} $j all A B]} {
810 set ok [expr {$i+0>=$A && $i+0<=$B}]
811 } else {
812 set ok [expr {$i+0>=0.9*$j && $i+0<=1.1*$j}]
813 }
814 if {!$ok} break
815 }
816 if {$ok && [llength $result]!=[llength $e2]} {set ok 0}
drh3f17aef2012-04-27 01:08:02 +0000817 } else {
drhc2b23e72013-11-13 15:32:15 +0000818 set re [string range $expected 1 end-1]
819 if {[string index $re 0]=="*"} {
820 # If the regular expression begins with * then treat it as a glob instead
821 set ok [string match $re $result]
822 } else {
823 set re [string map {# {[-0-9.]+}} $re]
824 set ok [regexp $re $result]
825 }
drh3f17aef2012-04-27 01:08:02 +0000826 }
drh70bdcc72013-05-30 19:28:34 +0000827 } elseif {[regexp {^~?\*.*\*$} $expected]} {
828 # "expected" is of the form "*GLOB*" then the result if correct if
829 # glob pattern GLOB matches the result. "~/GLOB/" means
830 # the glob must not match.
831 if {[string index $expected 0]=="~"} {
832 set e [string range $expected 1 end]
833 set ok [expr {![string match $e $result]}]
834 } else {
835 set ok [string match $expected $result]
836 }
drh3f17aef2012-04-27 01:08:02 +0000837 } else {
838 set ok [expr {[string compare $result $expected]==0}]
839 }
840 if {!$ok} {
mistachkinc60941f2012-09-13 01:51:02 +0000841 # if {![info exists ::testprefix] || $::testprefix eq ""} {
842 # error "no test prefix"
843 # }
drhd66b2e02015-11-12 21:42:40 +0000844 output1 ""
drh061d35c2015-11-13 00:03:14 +0000845 output2 "! $name expected: \[$expected\]\n! $name got: \[$result\]"
drh3f17aef2012-04-27 01:08:02 +0000846 fail_test $name
847 } else {
dan17c08232015-06-09 15:58:28 +0000848 output1 " Ok"
drh3f17aef2012-04-27 01:08:02 +0000849 }
mistachkin6c3c1a02011-11-12 03:17:40 +0000850 }
drh348784e2000-05-29 20:41:49 +0000851 } else {
dan17c08232015-06-09 15:58:28 +0000852 output1 " Omitted"
mistachkin6c3c1a02011-11-12 03:17:40 +0000853 omit_test $name "pattern mismatch" 0
drh348784e2000-05-29 20:41:49 +0000854 }
drh6558db82007-04-13 03:23:21 +0000855 flush stdout
drh348784e2000-05-29 20:41:49 +0000856}
dana3f51082010-09-30 18:43:14 +0000857
mistachkinf21979d2015-01-18 05:35:01 +0000858proc dumpbytes {s} {
859 set r ""
860 for {set i 0} {$i < [string length $s]} {incr i} {
861 if {$i > 0} {append r " "}
862 append r [format %02X [scan [string index $s $i] %c]]
863 }
864 return $r
865}
866
drh8df91852012-04-24 12:46:05 +0000867proc catchcmd {db {cmd ""}} {
868 global CLI
869 set out [open cmds.txt w]
870 puts $out $cmd
871 close $out
872 set line "exec $CLI $db < cmds.txt"
873 set rc [catch { eval $line } msg]
874 list $rc $msg
875}
876
mistachkinf21979d2015-01-18 05:35:01 +0000877proc catchcmdex {db {cmd ""}} {
878 global CLI
879 set out [open cmds.txt w]
880 fconfigure $out -encoding binary -translation binary
881 puts -nonewline $out $cmd
882 close $out
883 set line "exec -keepnewline -- $CLI $db < cmds.txt"
884 set chans [list stdin stdout stderr]
885 foreach chan $chans {
886 catch {
887 set modes($chan) [fconfigure $chan]
888 fconfigure $chan -encoding binary -translation binary -buffering none
889 }
890 }
891 set rc [catch { eval $line } msg]
892 foreach chan $chans {
893 catch {
894 eval fconfigure [list $chan] $modes($chan)
895 }
896 }
897 # puts [dumpbytes $msg]
898 list $rc $msg
899}
900
shaneh55505172011-06-21 19:30:19 +0000901proc filepath_normalize {p} {
902 # test cases should be written to assume "unix"-like file paths
shaneh285a18f2011-06-21 19:39:59 +0000903 if {$::tcl_platform(platform)!="unix"} {
shaneh55505172011-06-21 19:30:19 +0000904 # lreverse*2 as a hack to remove any unneeded {} after the string map
905 lreverse [lreverse [string map {\\ /} [regsub -nocase -all {[a-z]:[/\\]+} $p {/}]]]
shanehc4896402011-06-21 19:38:16 +0000906 } {
907 set p
shaneh55505172011-06-21 19:30:19 +0000908 }
909}
910proc do_filepath_test {name cmd expected} {
911 uplevel [list do_test $name [
912 subst -nocommands { filepath_normalize [ $cmd ] }
913 ] [filepath_normalize $expected]]
914}
915
dan33f53792011-05-05 19:44:22 +0000916proc realnum_normalize {r} {
shaneh4f529e82011-06-20 17:41:41 +0000917 # different TCL versions display floating point values differently.
918 string map {1.#INF inf Inf inf .0e e} [regsub -all {(e[+-])0+} $r {\1}]
dan33f53792011-05-05 19:44:22 +0000919}
920proc do_realnum_test {name cmd expected} {
921 uplevel [list do_test $name [
922 subst -nocommands { realnum_normalize [ $cmd ] }
923 ] [realnum_normalize $expected]]
924}
925
dana3f51082010-09-30 18:43:14 +0000926proc fix_testname {varname} {
927 upvar $varname testname
mistachkin1d406e02013-08-29 01:09:14 +0000928 if {[info exists ::testprefix]
dana3f51082010-09-30 18:43:14 +0000929 && [string is digit [string range $testname 0 0]]
930 } {
931 set testname "${::testprefix}-$testname"
932 }
933}
dan67340072011-04-16 19:23:10 +0000934
935proc normalize_list {L} {
936 set L2 [list]
937 foreach l $L {lappend L2 $l}
938 set L2
939}
drh5f9742e2013-08-29 15:08:38 +0000940
danff677b22017-02-04 17:33:30 +0000941# Either:
942#
943# do_execsql_test TESTNAME SQL ?RES?
944# do_execsql_test -db DB TESTNAME SQL ?RES?
945#
946proc do_execsql_test {args} {
947 set db db
948 if {[lindex $args 0]=="-db"} {
949 set db [lindex $args 1]
950 set args [lrange $args 2 end]
951 }
952
953 if {[llength $args]==2} {
954 foreach {testname sql} $args {}
955 set result ""
956 } elseif {[llength $args]==3} {
957 foreach {testname sql result} $args {}
dan9274ad82019-01-14 19:13:30 +0000958
959 # With some versions of Tcl on windows, if $result is all whitespace but
960 # contains some CR/LF characters, the [list {*}$result] below returns a
961 # copy of $result instead of a zero length string. Not clear exactly why
962 # this is. The following is a workaround.
963 if {[llength $result]==0} { set result "" }
danff677b22017-02-04 17:33:30 +0000964 } else {
965 error [string trim {
966 wrong # args: should be "do_execsql_test ?-db DB? testname sql ?result?"
967 }]
968 }
969
dana3f51082010-09-30 18:43:14 +0000970 fix_testname testname
danff677b22017-02-04 17:33:30 +0000971
972 uplevel do_test \
973 [list $testname] \
974 [list "execsql {$sql} $db"] \
975 [list [list {*}$result]]
dan153eda02010-06-21 07:45:47 +0000976}
danff677b22017-02-04 17:33:30 +0000977
dan153eda02010-06-21 07:45:47 +0000978proc do_catchsql_test {testname sql result} {
dana3f51082010-09-30 18:43:14 +0000979 fix_testname testname
dan99ebad92011-06-13 09:11:01 +0000980 uplevel do_test [list $testname] [list "catchsql {$sql}"] [list $result]
dan153eda02010-06-21 07:45:47 +0000981}
drh3c2aeae2014-01-24 14:37:44 +0000982proc do_timed_execsql_test {testname sql {result {}}} {
983 fix_testname testname
984 uplevel do_test [list $testname] [list "execsql_timed {$sql}"]\
985 [list [list {*}$result]]
986}
drh03c39052018-05-02 14:24:34 +0000987
988# Run an EXPLAIN QUERY PLAN $sql in database "db". Then rewrite the output
989# as an ASCII-art graph and return a string that is that graph.
990#
991# Hexadecimal literals in the output text are converted into "xxxxxx" since those
992# literals are pointer values that might very from one run of the test to the
993# next, yet we want the output to be consistent.
994#
995proc query_plan_graph {sql} {
996 db eval "EXPLAIN QUERY PLAN $sql" {
997 set dx($id) $detail
998 lappend cx($parent) $id
999 }
1000 set a "\n QUERY PLAN\n"
1001 append a [append_graph " " dx cx 0]
drhfef37762018-07-10 19:48:35 +00001002 regsub -all { 0x[A-F0-9]+\y} $a { xxxxxx} a
1003 regsub -all {(MATERIALIZE|CO-ROUTINE|SUBQUERY) \d+\y} $a {\1 xxxxxx} a
1004 return $a
dan39854792010-11-15 16:12:58 +00001005}
dan153eda02010-06-21 07:45:47 +00001006
drh03c39052018-05-02 14:24:34 +00001007# Helper routine for [query_plan_graph SQL]:
1008#
1009# Output rows of the graph that are children of $level.
1010#
1011# prefix: Prepend to every output line
1012#
1013# dxname: Name of an array variable that stores text describe
1014# The description for $id is $dx($id)
1015#
1016# cxname: Name of an array variable holding children of item.
1017# Children of $id are $cx($id)
1018#
1019# level: Render all lines that are children of $level
1020#
1021proc append_graph {prefix dxname cxname level} {
1022 upvar $dxname dx $cxname cx
1023 set a ""
1024 set x $cx($level)
1025 set n [llength $x]
1026 for {set i 0} {$i<$n} {incr i} {
1027 set id [lindex $x $i]
1028 if {$i==$n-1} {
1029 set p1 "`--"
1030 set p2 " "
1031 } else {
1032 set p1 "|--"
1033 set p2 "| "
1034 }
1035 append a $prefix$p1$dx($id)\n
1036 if {[info exists cx($id)]} {
1037 append a [append_graph "$prefix$p2" dx cx $id]
1038 }
1039 }
1040 return $a
1041}
1042
1043# Do an EXPLAIN QUERY PLAN test on input $sql with expected results $res
1044#
1045# If $res begins with a "\s+QUERY PLAN\n" then it is assumed to be the
1046# complete graph which must match the output of [query_plan_graph $sql]
1047# exactly.
1048#
1049# If $res does not begin with "\s+QUERY PLAN\n" then take it is a string
1050# that must be found somewhere in the query plan output.
1051#
1052proc do_eqp_test {name sql res} {
1053 if {[regexp {^\s+QUERY PLAN\n} $res]} {
1054 uplevel do_test $name [list [list query_plan_graph $sql]] [list $res]
1055 } else {
1056 if {[string index $res 0]!="/"} {
1057 set res "/*$res*/"
1058 }
1059 uplevel do_execsql_test $name [list "EXPLAIN QUERY PLAN $sql"] [list $res]
1060 }
1061}
1062
1063
dan51f06982010-09-18 19:00:12 +00001064#-------------------------------------------------------------------------
1065# Usage: do_select_tests PREFIX ?SWITCHES? TESTLIST
1066#
1067# Where switches are:
1068#
1069# -errorformat FMTSTRING
1070# -count
danaf1dcab2010-09-20 19:17:53 +00001071# -query SQL
dana16d1062010-09-28 17:37:28 +00001072# -tclquery TCL
danaf7626f2010-09-23 18:47:36 +00001073# -repair TCL
dan51f06982010-09-18 19:00:12 +00001074#
1075proc do_select_tests {prefix args} {
1076
1077 set testlist [lindex $args end]
1078 set switches [lrange $args 0 end-1]
1079
1080 set errfmt ""
1081 set countonly 0
dana16d1062010-09-28 17:37:28 +00001082 set tclquery ""
danaf7626f2010-09-23 18:47:36 +00001083 set repair ""
dan51f06982010-09-18 19:00:12 +00001084
1085 for {set i 0} {$i < [llength $switches]} {incr i} {
1086 set s [lindex $switches $i]
1087 set n [string length $s]
danaf1dcab2010-09-20 19:17:53 +00001088 if {$n>=2 && [string equal -length $n $s "-query"]} {
dana16d1062010-09-28 17:37:28 +00001089 set tclquery [list execsql [lindex $switches [incr i]]]
1090 } elseif {$n>=2 && [string equal -length $n $s "-tclquery"]} {
1091 set tclquery [lindex $switches [incr i]]
danaf1dcab2010-09-20 19:17:53 +00001092 } elseif {$n>=2 && [string equal -length $n $s "-errorformat"]} {
dan51f06982010-09-18 19:00:12 +00001093 set errfmt [lindex $switches [incr i]]
danaf7626f2010-09-23 18:47:36 +00001094 } elseif {$n>=2 && [string equal -length $n $s "-repair"]} {
1095 set repair [lindex $switches [incr i]]
dan51f06982010-09-18 19:00:12 +00001096 } elseif {$n>=2 && [string equal -length $n $s "-count"]} {
1097 set countonly 1
1098 } else {
1099 error "unknown switch: $s"
1100 }
1101 }
1102
1103 if {$countonly && $errfmt!=""} {
1104 error "Cannot use -count and -errorformat together"
1105 }
1106 set nTestlist [llength $testlist]
1107 if {$nTestlist%3 || $nTestlist==0 } {
1108 error "SELECT test list contains [llength $testlist] elements"
1109 }
1110
danaf7626f2010-09-23 18:47:36 +00001111 eval $repair
dan51f06982010-09-18 19:00:12 +00001112 foreach {tn sql res} $testlist {
dana16d1062010-09-28 17:37:28 +00001113 if {$tclquery != ""} {
danaf1dcab2010-09-20 19:17:53 +00001114 execsql $sql
dana16d1062010-09-28 17:37:28 +00001115 uplevel do_test ${prefix}.$tn [list $tclquery] [list [list {*}$res]]
1116 } elseif {$countonly} {
dan51f06982010-09-18 19:00:12 +00001117 set nRow 0
1118 db eval $sql {incr nRow}
1119 uplevel do_test ${prefix}.$tn [list [list set {} $nRow]] [list $res]
1120 } elseif {$errfmt==""} {
1121 uplevel do_execsql_test ${prefix}.${tn} [list $sql] [list [list {*}$res]]
1122 } else {
1123 set res [list 1 [string trim [format $errfmt {*}$res]]]
1124 uplevel do_catchsql_test ${prefix}.${tn} [list $sql] [list $res]
1125 }
danaf7626f2010-09-23 18:47:36 +00001126 eval $repair
dan51f06982010-09-18 19:00:12 +00001127 }
danaf7626f2010-09-23 18:47:36 +00001128
dan51f06982010-09-18 19:00:12 +00001129}
1130
danb04757a2010-09-21 16:59:16 +00001131proc delete_all_data {} {
1132 db eval {SELECT tbl_name AS t FROM sqlite_master WHERE type = 'table'} {
1133 db eval "DELETE FROM '[string map {' ''} $t]'"
1134 }
1135}
drh348784e2000-05-29 20:41:49 +00001136
mistachkin1d406e02013-08-29 01:09:14 +00001137# Run an SQL script.
drhb62c3352006-11-23 09:39:16 +00001138# Return the number of microseconds per statement.
1139#
drh3590f152006-11-23 21:09:10 +00001140proc speed_trial {name numstmt units sql} {
dan17c08232015-06-09 15:58:28 +00001141 output2 -nonewline [format {%-21.21s } $name...]
drhb62c3352006-11-23 09:39:16 +00001142 flush stdout
1143 set speed [time {sqlite3_exec_nr db $sql}]
1144 set tm [lindex $speed 0]
danielk19770ee26d92008-02-08 18:25:29 +00001145 if {$tm == 0} {
1146 set rate [format %20s "many"]
1147 } else {
1148 set rate [format %20.5f [expr {1000000.0*$numstmt/$tm}]]
1149 }
drh3590f152006-11-23 21:09:10 +00001150 set u2 $units/s
dan17c08232015-06-09 15:58:28 +00001151 output2 [format {%12d uS %s %s} $tm $rate $u2]
drhdd924312007-03-31 22:34:16 +00001152 global total_time
1153 set total_time [expr {$total_time+$tm}]
dana975b592010-10-08 16:09:43 +00001154 lappend ::speed_trial_times $name $tm
drhdd924312007-03-31 22:34:16 +00001155}
drh45c236d2008-03-22 01:08:00 +00001156proc speed_trial_tcl {name numstmt units script} {
dan17c08232015-06-09 15:58:28 +00001157 output2 -nonewline [format {%-21.21s } $name...]
drh45c236d2008-03-22 01:08:00 +00001158 flush stdout
1159 set speed [time {eval $script}]
1160 set tm [lindex $speed 0]
1161 if {$tm == 0} {
1162 set rate [format %20s "many"]
1163 } else {
1164 set rate [format %20.5f [expr {1000000.0*$numstmt/$tm}]]
1165 }
1166 set u2 $units/s
dan17c08232015-06-09 15:58:28 +00001167 output2 [format {%12d uS %s %s} $tm $rate $u2]
drh45c236d2008-03-22 01:08:00 +00001168 global total_time
1169 set total_time [expr {$total_time+$tm}]
dana975b592010-10-08 16:09:43 +00001170 lappend ::speed_trial_times $name $tm
drh45c236d2008-03-22 01:08:00 +00001171}
drhdd924312007-03-31 22:34:16 +00001172proc speed_trial_init {name} {
1173 global total_time
1174 set total_time 0
dana975b592010-10-08 16:09:43 +00001175 set ::speed_trial_times [list]
drhbb810a92010-07-03 12:00:53 +00001176 sqlite3 versdb :memory:
1177 set vers [versdb one {SELECT sqlite_source_id()}]
1178 versdb close
dan17c08232015-06-09 15:58:28 +00001179 output2 "SQLite $vers"
drhdd924312007-03-31 22:34:16 +00001180}
1181proc speed_trial_summary {name} {
1182 global total_time
dan17c08232015-06-09 15:58:28 +00001183 output2 [format {%-21.21s %12d uS TOTAL} $name $total_time]
dana975b592010-10-08 16:09:43 +00001184
1185 if { 0 } {
1186 sqlite3 versdb :memory:
1187 set vers [lindex [versdb one {SELECT sqlite_source_id()}] 0]
1188 versdb close
dan17c08232015-06-09 15:58:28 +00001189 output2 "CREATE TABLE IF NOT EXISTS time(version, script, test, us);"
dana975b592010-10-08 16:09:43 +00001190 foreach {test us} $::speed_trial_times {
dan17c08232015-06-09 15:58:28 +00001191 output2 "INSERT INTO time VALUES('$vers', '$name', '$test', $us);"
dana975b592010-10-08 16:09:43 +00001192 }
1193 }
drhb62c3352006-11-23 09:39:16 +00001194}
1195
drh348784e2000-05-29 20:41:49 +00001196# Run this routine last
1197#
1198proc finish_test {} {
danc1a60c52010-06-07 14:28:16 +00001199 catch {db close}
dane8559832014-07-31 17:35:40 +00001200 catch {db1 close}
danc1a60c52010-06-07 14:28:16 +00001201 catch {db2 close}
1202 catch {db3 close}
1203 if {0==[info exists ::SLAVE]} { finalize_testing }
drha1b351a2001-09-14 16:42:12 +00001204}
1205proc finalize_testing {} {
danc1a60c52010-06-07 14:28:16 +00001206 global sqlite_open_file_count
1207
1208 set omitList [set_test_counter omit_list]
danielk19772e588c72005-12-09 14:25:08 +00001209
drh6e142f52000-06-08 13:36:40 +00001210 catch {db close}
danielk19772e588c72005-12-09 14:25:08 +00001211 catch {db2 close}
1212 catch {db3 close}
1213
drh9bc54492007-10-23 14:49:59 +00001214 vfs_unlink_test
drhb4bc7052006-01-11 23:40:33 +00001215 sqlite3 db {}
danielk1977cbb84962006-01-17 16:10:13 +00001216 # sqlite3_clear_tsd_memdebug
drhb4bc7052006-01-11 23:40:33 +00001217 db close
drh984bfaa2008-03-19 16:08:53 +00001218 sqlite3_reset_auto_extension
danc1a60c52010-06-07 14:28:16 +00001219
drh31999c52019-11-14 17:46:32 +00001220 sqlite3_soft_heap_limit64 0
1221 sqlite3_hard_heap_limit64 0
danc1a60c52010-06-07 14:28:16 +00001222 set nTest [incr_ntest]
1223 set nErr [set_test_counter errors]
1224
drhef866372013-05-22 20:49:02 +00001225 set nKnown 0
1226 if {[file readable known-problems.txt]} {
1227 set fd [open known-problems.txt]
1228 set content [read $fd]
1229 close $fd
1230 foreach x $content {set known_error($x) 1}
1231 foreach x [set_test_counter fail_list] {
1232 if {[info exists known_error($x)]} {incr nKnown}
1233 }
1234 }
1235 if {$nKnown>0} {
dan17c08232015-06-09 15:58:28 +00001236 output2 "[expr {$nErr-$nKnown}] new errors and $nKnown known errors\
drhef866372013-05-22 20:49:02 +00001237 out of $nTest tests"
1238 } else {
drh72bf6a32016-01-07 02:06:55 +00001239 set cpuinfo {}
1240 if {[catch {exec hostname} hname]==0} {set cpuinfo [string trim $hname]}
1241 append cpuinfo " $::tcl_platform(os)"
1242 append cpuinfo " [expr {$::tcl_platform(pointerSize)*8}]-bit"
1243 append cpuinfo " [string map {E -e} $::tcl_platform(byteOrder)]"
1244 output2 "SQLite [sqlite3 -sourceid]"
1245 output2 "$nErr errors out of $nTest tests on $cpuinfo"
drhef866372013-05-22 20:49:02 +00001246 }
1247 if {$nErr>$nKnown} {
drh061d35c2015-11-13 00:03:14 +00001248 output2 -nonewline "!Failures on these tests:"
drhef866372013-05-22 20:49:02 +00001249 foreach x [set_test_counter fail_list] {
dan17c08232015-06-09 15:58:28 +00001250 if {![info exists known_error($x)]} {output2 -nonewline " $x"}
drhef866372013-05-22 20:49:02 +00001251 }
dan17c08232015-06-09 15:58:28 +00001252 output2 ""
drhf3a65f72007-08-22 20:18:21 +00001253 }
drhcca17c32013-04-19 12:32:52 +00001254 foreach warning [set_test_counter warn_list] {
dan17c08232015-06-09 15:58:28 +00001255 output2 "Warning: $warning"
drhcca17c32013-04-19 12:32:52 +00001256 }
danielk1977ee8b7992009-03-26 17:13:06 +00001257 run_thread_tests 1
drh521cc842008-04-15 02:36:33 +00001258 if {[llength $omitList]>0} {
dan17c08232015-06-09 15:58:28 +00001259 output2 "Omitted test cases:"
drh521cc842008-04-15 02:36:33 +00001260 set prec {}
1261 foreach {rec} [lsort $omitList] {
1262 if {$rec==$prec} continue
1263 set prec $rec
drhd66b2e02015-11-12 21:42:40 +00001264 output2 [format {. %-12s %s} [lindex $rec 0] [lindex $rec 1]]
drh521cc842008-04-15 02:36:33 +00001265 }
1266 }
drh80788d82006-09-02 14:50:23 +00001267 if {$nErr>0 && ![working_64bit_int]} {
dan17c08232015-06-09 15:58:28 +00001268 output2 "******************************************************************"
1269 output2 "N.B.: The version of TCL that you used to build this test harness"
1270 output2 "is defective in that it does not support 64-bit integers. Some or"
1271 output2 "all of the test failures above might be a result from this defect"
1272 output2 "in your TCL build."
1273 output2 "******************************************************************"
drhdb25e382001-03-15 18:21:22 +00001274 }
danc1a60c52010-06-07 14:28:16 +00001275 if {$::cmdlinearg(binarylog)} {
danfbefb892010-05-12 19:02:35 +00001276 vfslog finalize binarylog
danielk1977374177e2008-05-08 15:58:06 +00001277 }
drh94e92032003-02-16 22:21:32 +00001278 if {$sqlite_open_file_count} {
dan17c08232015-06-09 15:58:28 +00001279 output2 "$sqlite_open_file_count files were left open"
drh94e92032003-02-16 22:21:32 +00001280 incr nErr
1281 }
drheafc43b2010-07-26 18:43:40 +00001282 if {[lindex [sqlite3_status SQLITE_STATUS_MALLOC_COUNT 0] 1]>0 ||
1283 [sqlite3_memory_used]>0} {
dan17c08232015-06-09 15:58:28 +00001284 output2 "Unfreed memory: [sqlite3_memory_used] bytes in\
drheafc43b2010-07-26 18:43:40 +00001285 [lindex [sqlite3_status SQLITE_STATUS_MALLOC_COUNT 0] 1] allocations"
drhf3a65f72007-08-22 20:18:21 +00001286 incr nErr
dan253c6ee2018-09-18 17:00:06 +00001287 ifcapable mem5||(mem3&&debug) {
dan17c08232015-06-09 15:58:28 +00001288 output2 "Writing unfreed memory log to \"./memleak.txt\""
drh4a50aac2007-08-23 02:47:53 +00001289 sqlite3_memdebug_dump ./memleak.txt
1290 }
drhf3a65f72007-08-22 20:18:21 +00001291 } else {
dan17c08232015-06-09 15:58:28 +00001292 output2 "All memory allocations freed - no leaks"
dan253c6ee2018-09-18 17:00:06 +00001293 ifcapable mem5 {
drhd2bb3272007-10-15 19:34:32 +00001294 sqlite3_memdebug_dump ./memusage.txt
1295 }
drhf3a65f72007-08-22 20:18:21 +00001296 }
drhf7141992008-06-19 00:16:08 +00001297 show_memstats
dan17c08232015-06-09 15:58:28 +00001298 output2 "Maximum memory usage: [sqlite3_memory_highwater 1] bytes"
1299 output2 "Current memory usage: [sqlite3_memory_highwater] bytes"
danielk1977a7a8e142008-02-13 18:25:27 +00001300 if {[info commands sqlite3_memdebug_malloc_count] ne ""} {
dan17c08232015-06-09 15:58:28 +00001301 output2 "Number of malloc() : [sqlite3_memdebug_malloc_count] calls"
danielk1977a7a8e142008-02-13 18:25:27 +00001302 }
danc1a60c52010-06-07 14:28:16 +00001303 if {$::cmdlinearg(malloctrace)} {
dan253c6ee2018-09-18 17:00:06 +00001304 output2 "Writing mallocs.tcl..."
1305 memdebug_log_sql mallocs.tcl
danielk197735754ac2008-03-21 17:29:37 +00001306 sqlite3_memdebug_log stop
1307 sqlite3_memdebug_log clear
danielk1977dbdc4d42008-03-28 07:42:53 +00001308 if {[sqlite3_memory_used]>0} {
dan253c6ee2018-09-18 17:00:06 +00001309 output2 "Writing leaks.tcl..."
danielk1977dbdc4d42008-03-28 07:42:53 +00001310 sqlite3_memdebug_log sync
dan253c6ee2018-09-18 17:00:06 +00001311 memdebug_log_sql leaks.tcl
danielk1977dbdc4d42008-03-28 07:42:53 +00001312 }
danielk197735754ac2008-03-21 17:29:37 +00001313 }
dan1d07f1d2019-04-01 17:24:20 +00001314 if {[info commands vdbe_coverage]!=""} {
1315 vdbe_coverage_report
1316 }
drhd9910fe2006-10-04 11:55:49 +00001317 foreach f [glob -nocomplain test.db-*-journal] {
mistachkinfda06be2011-08-02 00:57:34 +00001318 forcedelete $f
drhd9910fe2006-10-04 11:55:49 +00001319 }
1320 foreach f [glob -nocomplain test.db-mj*] {
mistachkinfda06be2011-08-02 00:57:34 +00001321 forcedelete $f
drhd9910fe2006-10-04 11:55:49 +00001322 }
drhdb25e382001-03-15 18:21:22 +00001323 exit [expr {$nErr>0}]
drh348784e2000-05-29 20:41:49 +00001324}
1325
dan1d07f1d2019-04-01 17:24:20 +00001326proc vdbe_coverage_report {} {
1327 puts "Writing vdbe coverage report to vdbe_coverage.txt"
1328 set lSrc [list]
1329 set iLine 0
1330 if {[file exists ../sqlite3.c]} {
1331 set fd [open ../sqlite3.c]
1332 set iLine
1333 while { ![eof $fd] } {
1334 set line [gets $fd]
1335 incr iLine
1336 if {[regexp {^/\** Begin file (.*\.c) \**/} $line -> file]} {
1337 lappend lSrc [list $iLine $file]
1338 }
1339 }
1340 close $fd
1341 }
1342 set fd [open vdbe_coverage.txt w]
1343 foreach miss [vdbe_coverage report] {
danafb3f3c2019-04-01 18:43:09 +00001344 foreach {line branch never} $miss {}
dan1d07f1d2019-04-01 17:24:20 +00001345 set nextfile ""
1346 while {[llength $lSrc]>0 && [lindex $lSrc 0 0] < $line} {
1347 set nextfile [lindex $lSrc 0 1]
1348 set lSrc [lrange $lSrc 1 end]
1349 }
1350 if {$nextfile != ""} {
1351 puts $fd ""
1352 puts $fd "### $nextfile ###"
1353 }
danafb3f3c2019-04-01 18:43:09 +00001354 puts $fd "Vdbe branch $line: never $never (path $branch)"
dan1d07f1d2019-04-01 17:24:20 +00001355 }
1356 close $fd
1357}
1358
drhf7141992008-06-19 00:16:08 +00001359# Display memory statistics for analysis and debugging purposes.
1360#
1361proc show_memstats {} {
1362 set x [sqlite3_status SQLITE_STATUS_MEMORY_USED 0]
drhe50135e2008-08-05 17:53:22 +00001363 set y [sqlite3_status SQLITE_STATUS_MALLOC_SIZE 0]
1364 set val [format {now %10d max %10d max-size %10d} \
1365 [lindex $x 1] [lindex $x 2] [lindex $y 2]]
dan17c08232015-06-09 15:58:28 +00001366 output1 "Memory used: $val"
drheafc43b2010-07-26 18:43:40 +00001367 set x [sqlite3_status SQLITE_STATUS_MALLOC_COUNT 0]
1368 set val [format {now %10d max %10d} [lindex $x 1] [lindex $x 2]]
dan17c08232015-06-09 15:58:28 +00001369 output1 "Allocation count: $val"
drhf7141992008-06-19 00:16:08 +00001370 set x [sqlite3_status SQLITE_STATUS_PAGECACHE_USED 0]
drhe50135e2008-08-05 17:53:22 +00001371 set y [sqlite3_status SQLITE_STATUS_PAGECACHE_SIZE 0]
1372 set val [format {now %10d max %10d max-size %10d} \
1373 [lindex $x 1] [lindex $x 2] [lindex $y 2]]
dan17c08232015-06-09 15:58:28 +00001374 output1 "Page-cache used: $val"
drhf7141992008-06-19 00:16:08 +00001375 set x [sqlite3_status SQLITE_STATUS_PAGECACHE_OVERFLOW 0]
1376 set val [format {now %10d max %10d} [lindex $x 1] [lindex $x 2]]
dan17c08232015-06-09 15:58:28 +00001377 output1 "Page-cache overflow: $val"
drhec424a52008-07-25 15:39:03 +00001378 ifcapable yytrackmaxstackdepth {
1379 set x [sqlite3_status SQLITE_STATUS_PARSER_STACK 0]
1380 set val [format { max %10d} [lindex $x 2]]
dan17c08232015-06-09 15:58:28 +00001381 output2 "Parser stack depth: $val"
drhec424a52008-07-25 15:39:03 +00001382 }
drhf7141992008-06-19 00:16:08 +00001383}
1384
drh348784e2000-05-29 20:41:49 +00001385# A procedure to execute SQL
1386#
drhc4a3c772001-04-04 11:48:57 +00001387proc execsql {sql {db db}} {
drhacbcdc42001-01-22 00:31:53 +00001388 # puts "SQL = $sql"
danielk19773bdca9c2006-01-17 09:35:01 +00001389 uplevel [list $db eval $sql]
drh348784e2000-05-29 20:41:49 +00001390}
drh3c2aeae2014-01-24 14:37:44 +00001391proc execsql_timed {sql {db db}} {
1392 set tm [time {
1393 set x [uplevel [list $db eval $sql]]
1394 } 1]
1395 set tm [lindex $tm 0]
dan17c08232015-06-09 15:58:28 +00001396 output1 -nonewline " ([expr {$tm*0.001}]ms) "
drh3c2aeae2014-01-24 14:37:44 +00001397 set x
1398}
drh3aadb2e2000-05-31 17:59:25 +00001399
drhadbca9c2001-09-27 15:11:53 +00001400# Execute SQL and catch exceptions.
1401#
1402proc catchsql {sql {db db}} {
1403 # puts "SQL = $sql"
dan81fa6dc2009-11-28 12:40:32 +00001404 set r [catch [list uplevel [list $db eval $sql]] msg]
drhadbca9c2001-09-27 15:11:53 +00001405 lappend r $msg
1406 return $r
1407}
1408
drh04096482001-11-09 22:41:44 +00001409# Do an VDBE code dump on the SQL given
1410#
1411proc explain {sql {db db}} {
mistachkineeb31ff2015-06-10 23:02:38 +00001412 output2 ""
1413 output2 "addr opcode p1 p2 p3 p4 p5 #"
1414 output2 "---- ------------ ------ ------ ------ --------------- -- -"
drh04096482001-11-09 22:41:44 +00001415 $db eval "explain $sql" {} {
mistachkineeb31ff2015-06-10 23:02:38 +00001416 output2 [format {%-4d %-12.12s %-6d %-6d %-6d % -17s %s %s} \
danielk1977287fb612008-01-04 19:10:28 +00001417 $addr $opcode $p1 $p2 $p3 $p4 $p5 $comment
1418 ]
drh04096482001-11-09 22:41:44 +00001419 }
1420}
1421
dane83267d2013-11-05 14:19:22 +00001422proc explain_i {sql {db db}} {
mistachkineeb31ff2015-06-10 23:02:38 +00001423 output2 ""
1424 output2 "addr opcode p1 p2 p3 p4 p5 #"
1425 output2 "---- ------------ ------ ------ ------ ---------------- -- -"
dane83267d2013-11-05 14:19:22 +00001426
dane83267d2013-11-05 14:19:22 +00001427
dan5c663c32013-11-06 14:52:40 +00001428 # Set up colors for the different opcodes. Scheme is as follows:
1429 #
1430 # Red: Opcodes that write to a b-tree.
1431 # Blue: Opcodes that reposition or seek a cursor.
1432 # Green: The ResultRow opcode.
1433 #
dandea63f22014-03-03 16:48:47 +00001434 if { [catch {fconfigure stdout -mode}]==0 } {
1435 set R "\033\[31;1m" ;# Red fg
1436 set G "\033\[32;1m" ;# Green fg
1437 set B "\033\[34;1m" ;# Red fg
1438 set D "\033\[39;0m" ;# Default fg
1439 } else {
1440 set R ""
1441 set G ""
1442 set B ""
1443 set D ""
1444 }
dan5c663c32013-11-06 14:52:40 +00001445 foreach opcode {
dan8da209b2016-07-26 18:06:08 +00001446 Seek SeekGE SeekGT SeekLE SeekLT NotFound Last Rewind
dane3ab7292013-11-12 12:30:09 +00001447 NoConflict Next Prev VNext VPrev VFilter
dan8da209b2016-07-26 18:06:08 +00001448 SorterSort SorterNext NextIfOpen
dan5c663c32013-11-06 14:52:40 +00001449 } {
1450 set color($opcode) $B
1451 }
1452 foreach opcode {ResultRow} {
1453 set color($opcode) $G
1454 }
1455 foreach opcode {IdxInsert Insert Delete IdxDelete} {
1456 set color($opcode) $R
1457 }
1458
dan427ebba2013-11-05 16:39:31 +00001459 set bSeenGoto 0
dane83267d2013-11-05 14:19:22 +00001460 $db eval "explain $sql" {} {
1461 set x($addr) 0
1462 set op($addr) $opcode
1463
dan427ebba2013-11-05 16:39:31 +00001464 if {$opcode == "Goto" && ($bSeenGoto==0 || ($p2 > $addr+10))} {
1465 set linebreak($p2) 1
1466 set bSeenGoto 1
dane83267d2013-11-05 14:19:22 +00001467 }
1468
dan8da209b2016-07-26 18:06:08 +00001469 if {$opcode=="Once"} {
1470 for {set i $addr} {$i<$p2} {incr i} {
1471 set star($i) $addr
1472 }
1473 }
1474
dane3ab7292013-11-12 12:30:09 +00001475 if {$opcode=="Next" || $opcode=="Prev"
1476 || $opcode=="VNext" || $opcode=="VPrev"
dan8da209b2016-07-26 18:06:08 +00001477 || $opcode=="SorterNext" || $opcode=="NextIfOpen"
dane3ab7292013-11-12 12:30:09 +00001478 } {
dane83267d2013-11-05 14:19:22 +00001479 for {set i $p2} {$i<$addr} {incr i} {
1480 incr x($i) 2
1481 }
1482 }
1483
1484 if {$opcode == "Goto" && $p2<$addr && $op($p2)=="Yield"} {
1485 for {set i [expr $p2+1]} {$i<$addr} {incr i} {
1486 incr x($i) 2
1487 }
1488 }
dan427ebba2013-11-05 16:39:31 +00001489
1490 if {$opcode == "Halt" && $comment == "End of coroutine"} {
1491 set linebreak([expr $addr+1]) 1
1492 }
dane83267d2013-11-05 14:19:22 +00001493 }
1494
1495 $db eval "explain $sql" {} {
dan427ebba2013-11-05 16:39:31 +00001496 if {[info exists linebreak($addr)]} {
mistachkineeb31ff2015-06-10 23:02:38 +00001497 output2 ""
dane83267d2013-11-05 14:19:22 +00001498 }
1499 set I [string repeat " " $x($addr)]
dan5c663c32013-11-06 14:52:40 +00001500
dan8da209b2016-07-26 18:06:08 +00001501 if {[info exists star($addr)]} {
1502 set ii [expr $x($star($addr))]
1503 append I " "
1504 set I [string replace $I $ii $ii *]
1505 }
1506
dan5c663c32013-11-06 14:52:40 +00001507 set col ""
1508 catch { set col $color($opcode) }
1509
mistachkineeb31ff2015-06-10 23:02:38 +00001510 output2 [format {%-4d %s%s%-12.12s%s %-6d %-6d %-6d % -17s %s %s} \
dan5c663c32013-11-06 14:52:40 +00001511 $addr $I $col $opcode $D $p1 $p2 $p3 $p4 $p5 $comment
dane83267d2013-11-05 14:19:22 +00001512 ]
dane83267d2013-11-05 14:19:22 +00001513 }
mistachkineeb31ff2015-06-10 23:02:38 +00001514 output2 "---- ------------ ------ ------ ------ ---------------- -- -"
dane83267d2013-11-05 14:19:22 +00001515}
1516
drhdafc0ce2008-04-17 19:14:02 +00001517# Show the VDBE program for an SQL statement but omit the Trace
1518# opcode at the beginning. This procedure can be used to prove
1519# that different SQL statements generate exactly the same VDBE code.
1520#
1521proc explain_no_trace {sql} {
1522 set tr [db eval "EXPLAIN $sql"]
1523 return [lrange $tr 7 end]
1524}
1525
drh3aadb2e2000-05-31 17:59:25 +00001526# Another procedure to execute SQL. This one includes the field
1527# names in the returned list.
1528#
1529proc execsql2 {sql} {
1530 set result {}
1531 db eval $sql data {
1532 foreach f $data(*) {
1533 lappend result $f $data($f)
1534 }
1535 }
1536 return $result
1537}
drh17a68932001-01-31 13:28:08 +00001538
mistachkin1d406e02013-08-29 01:09:14 +00001539# Use a temporary in-memory database to execute SQL statements
1540#
1541proc memdbsql {sql} {
1542 sqlite3 memdb :memory:
1543 set result [memdb eval $sql]
1544 memdb close
1545 return $result
1546}
1547
drhdde85d92003-03-01 19:45:34 +00001548# Use the non-callback API to execute multiple SQL statements
1549#
1550proc stepsql {dbptr sql} {
1551 set sql [string trim $sql]
1552 set r 0
1553 while {[string length $sql]>0} {
danielk19774ad17132004-05-21 01:47:26 +00001554 if {[catch {sqlite3_prepare $dbptr $sql -1 sqltail} vm]} {
drhdde85d92003-03-01 19:45:34 +00001555 return [list 1 $vm]
1556 }
1557 set sql [string trim $sqltail]
danielk1977fbcd5852004-06-15 02:44:18 +00001558# while {[sqlite_step $vm N VAL COL]=="SQLITE_ROW"} {
1559# foreach v $VAL {lappend r $v}
1560# }
1561 while {[sqlite3_step $vm]=="SQLITE_ROW"} {
1562 for {set i 0} {$i<[sqlite3_data_count $vm]} {incr i} {
1563 lappend r [sqlite3_column_text $vm $i]
1564 }
drhdde85d92003-03-01 19:45:34 +00001565 }
danielk1977106bb232004-05-21 10:08:53 +00001566 if {[catch {sqlite3_finalize $vm} errmsg]} {
drhdde85d92003-03-01 19:45:34 +00001567 return [list 1 $errmsg]
1568 }
1569 }
1570 return $r
1571}
1572
drh21504322002-06-25 13:16:02 +00001573# Do an integrity check of the entire database
1574#
danielk197704103022009-02-03 16:51:24 +00001575proc integrity_check {name {db db}} {
drh27d258a2004-10-30 20:23:09 +00001576 ifcapable integrityck {
danielk197704103022009-02-03 16:51:24 +00001577 do_test $name [list execsql {PRAGMA integrity_check} $db] {ok}
drh27d258a2004-10-30 20:23:09 +00001578 }
1579}
1580
drh433dccf2013-02-09 15:37:11 +00001581# Check the extended error code
1582#
1583proc verify_ex_errcode {name expected {db db}} {
1584 do_test $name [list sqlite3_extended_errcode $db] $expected
1585}
1586
danc6055c72011-04-28 18:46:46 +00001587
1588# Return true if the SQL statement passed as the second argument uses a
1589# statement transaction.
1590#
1591proc sql_uses_stmt {db sql} {
1592 set stmt [sqlite3_prepare $db $sql -1 dummy]
1593 set uses [uses_stmt_journal $stmt]
1594 sqlite3_finalize $stmt
1595 return $uses
1596}
1597
danielk1977db4e8862008-01-16 08:24:46 +00001598proc fix_ifcapable_expr {expr} {
1599 set ret ""
1600 set state 0
1601 for {set i 0} {$i < [string length $expr]} {incr i} {
1602 set char [string range $expr $i $i]
1603 set newstate [expr {[string is alnum $char] || $char eq "_"}]
1604 if {$newstate && !$state} {
1605 append ret {$::sqlite_options(}
1606 }
1607 if {!$newstate && $state} {
1608 append ret )
1609 }
1610 append ret $char
1611 set state $newstate
1612 }
1613 if {$state} {append ret )}
1614 return $ret
1615}
1616
mistachkinc60941f2012-09-13 01:51:02 +00001617# Returns non-zero if the capabilities are present; zero otherwise.
1618#
1619proc capable {expr} {
1620 set e [fix_ifcapable_expr $expr]; return [expr ($e)]
1621}
1622
drh27d258a2004-10-30 20:23:09 +00001623# Evaluate a boolean expression of capabilities. If true, execute the
1624# code. Omit the code if false.
1625#
danielk19773e8c37e2005-01-21 03:12:14 +00001626proc ifcapable {expr code {else ""} {elsecode ""}} {
danielk1977db4e8862008-01-16 08:24:46 +00001627 #regsub -all {[a-z_0-9]+} $expr {$::sqlite_options(&)} e2
1628 set e2 [fix_ifcapable_expr $expr]
danielk19773e8c37e2005-01-21 03:12:14 +00001629 if ($e2) {
1630 set c [catch {uplevel 1 $code} r]
1631 } else {
1632 set c [catch {uplevel 1 $elsecode} r]
1633 }
1634 return -code $c $r
drh21504322002-06-25 13:16:02 +00001635}
danielk197745901d62004-11-10 15:27:38 +00001636
danielk1977aca790a2005-01-13 11:07:52 +00001637# This proc execs a seperate process that crashes midway through executing
1638# the SQL script $sql on database test.db.
1639#
1640# The crash occurs during a sync() of file $crashfile. When the crash
1641# occurs a random subset of all unsynced writes made by the process are
1642# written into the files on disk. Argument $crashdelay indicates the
1643# number of file syncs to wait before crashing.
1644#
1645# The return value is a list of two elements. The first element is a
1646# boolean, indicating whether or not the process actually crashed or
1647# reported some other error. The second element in the returned list is the
1648# error message. This is "child process exited abnormally" if the crash
mistachkin48864df2013-03-21 21:20:32 +00001649# occurred.
danielk1977aca790a2005-01-13 11:07:52 +00001650#
danielk1977f8940ae2007-08-23 11:07:10 +00001651# crashsql -delay CRASHDELAY -file CRASHFILE ?-blocksize BLOCKSIZE? $sql
danielk197759a33f92007-03-17 10:26:59 +00001652#
1653proc crashsql {args} {
danielk197759a33f92007-03-17 10:26:59 +00001654
1655 set blocksize ""
1656 set crashdelay 1
drhcb1f0f62008-01-08 15:18:52 +00001657 set prngseed 0
dan999cd082013-12-09 20:42:03 +00001658 set opendb { sqlite3 db test.db -vfs crash }
drhf8587402008-01-08 16:03:49 +00001659 set tclbody {}
danielk197759a33f92007-03-17 10:26:59 +00001660 set crashfile ""
danielk1977f8940ae2007-08-23 11:07:10 +00001661 set dc ""
dancb1b0a62017-03-02 14:51:47 +00001662 set dfltvfs 0
danielk197759a33f92007-03-17 10:26:59 +00001663 set sql [lindex $args end]
mistachkin1d406e02013-08-29 01:09:14 +00001664
danielk197759a33f92007-03-17 10:26:59 +00001665 for {set ii 0} {$ii < [llength $args]-1} {incr ii 2} {
1666 set z [lindex $args $ii]
1667 set n [string length $z]
1668 set z2 [lindex $args [expr $ii+1]]
1669
1670 if {$n>1 && [string first $z -delay]==0} {set crashdelay $z2} \
dan999cd082013-12-09 20:42:03 +00001671 elseif {$n>1 && [string first $z -opendb]==0} {set opendb $z2} \
drhcb1f0f62008-01-08 15:18:52 +00001672 elseif {$n>1 && [string first $z -seed]==0} {set prngseed $z2} \
danielk197759a33f92007-03-17 10:26:59 +00001673 elseif {$n>1 && [string first $z -file]==0} {set crashfile $z2} \
drhf8587402008-01-08 16:03:49 +00001674 elseif {$n>1 && [string first $z -tclbody]==0} {set tclbody $z2} \
danielk1977967a4a12007-08-20 14:23:44 +00001675 elseif {$n>1 && [string first $z -blocksize]==0} {set blocksize "-s $z2" } \
dancb1b0a62017-03-02 14:51:47 +00001676 elseif {$n>1 && [string first $z -characteristics]==0} {set dc "-c {$z2}" }\
1677 elseif {$n>1 && [string first $z -dfltvfs]==0} {set dfltvfs $z2 }\
danielk197759a33f92007-03-17 10:26:59 +00001678 else { error "Unrecognized option: $z" }
1679 }
1680
1681 if {$crashfile eq ""} {
1682 error "Compulsory option -file missing"
1683 }
1684
mistachkin1d406e02013-08-29 01:09:14 +00001685 # $crashfile gets compared to the native filename in
shanehf2c08822010-07-08 16:30:44 +00001686 # cfSync(), which can be different then what TCL uses by
1687 # default, so here we force it to the "nativename" format.
mistachkinf8a78462012-03-08 20:00:36 +00001688 set cfile [string map {\\ \\\\} [file nativename [file join [get_pwd] $crashfile]]]
danielk1977aca790a2005-01-13 11:07:52 +00001689
1690 set f [open crash.tcl w]
dancb1b0a62017-03-02 14:51:47 +00001691 puts $f "sqlite3_crash_enable 1 $dfltvfs"
danielk1977f8940ae2007-08-23 11:07:10 +00001692 puts $f "sqlite3_crashparams $blocksize $dc $crashdelay $cfile"
drhc7a3bb92009-02-05 16:31:45 +00001693 puts $f "sqlite3_test_control_pending_byte $::sqlite_pending_byte"
danielk1977933bbd62007-03-17 07:22:42 +00001694
1695 # This block sets the cache size of the main database to 10
1696 # pages. This is done in case the build is configured to omit
1697 # "PRAGMA cache_size".
danec16d982015-04-17 08:36:05 +00001698 if {$opendb!=""} {
1699 puts $f $opendb
1700 puts $f {db eval {SELECT * FROM sqlite_master;}}
1701 puts $f {set bt [btree_from_db db]}
1702 puts $f {btree_set_cache_size $bt 10}
1703 }
dan999cd082013-12-09 20:42:03 +00001704
drhcb1f0f62008-01-08 15:18:52 +00001705 if {$prngseed} {
1706 set seed [expr {$prngseed%10007+1}]
1707 # puts seed=$seed
1708 puts $f "db eval {SELECT randomblob($seed)}"
1709 }
danielk1977933bbd62007-03-17 07:22:42 +00001710
drhf8587402008-01-08 16:03:49 +00001711 if {[string length $tclbody]>0} {
1712 puts $f $tclbody
1713 }
1714 if {[string length $sql]>0} {
1715 puts $f "db eval {"
1716 puts $f "$sql"
1717 puts $f "}"
1718 }
danielk1977aca790a2005-01-13 11:07:52 +00001719 close $f
danielk1977aca790a2005-01-13 11:07:52 +00001720 set r [catch {
drh9c06c952005-11-26 00:25:00 +00001721 exec [info nameofexec] crash.tcl >@stdout
danielk1977aca790a2005-01-13 11:07:52 +00001722 } msg]
mistachkin1d406e02013-08-29 01:09:14 +00001723
shanehf2c08822010-07-08 16:30:44 +00001724 # Windows/ActiveState TCL returns a slightly different
1725 # error message. We map that to the expected message
1726 # so that we don't have to change all of the test
1727 # cases.
1728 if {$::tcl_platform(platform)=="windows"} {
1729 if {$msg=="child killed: unknown signal"} {
1730 set msg "child process exited abnormally"
1731 }
1732 }
mistachkin1d406e02013-08-29 01:09:14 +00001733
danielk1977aca790a2005-01-13 11:07:52 +00001734 lappend r $msg
1735}
1736
dan33447e72017-07-22 20:12:31 +00001737# crash_on_write ?-devchar DEVCHAR? CRASHDELAY SQL
1738#
1739proc crash_on_write {args} {
1740
1741 set nArg [llength $args]
1742 if {$nArg<2 || $nArg%2} {
1743 error "bad args: $args"
1744 }
1745 set zSql [lindex $args end]
1746 set nDelay [lindex $args end-1]
1747
1748 set devchar {}
1749 for {set ii 0} {$ii < $nArg-2} {incr ii 2} {
1750 set opt [lindex $args $ii]
1751 switch -- [lindex $args $ii] {
1752 -devchar {
1753 set devchar [lindex $args [expr $ii+1]]
1754 }
1755
1756 default { error "unrecognized option: $opt" }
1757 }
1758 }
1759
1760 set f [open crash.tcl w]
1761 puts $f "sqlite3_crash_on_write $nDelay"
1762 puts $f "sqlite3_test_control_pending_byte $::sqlite_pending_byte"
1763 puts $f "sqlite3 db test.db -vfs writecrash"
1764 puts $f "db eval {$zSql}"
1765 puts $f "set {} {}"
1766
1767 close $f
1768 set r [catch {
1769 exec [info nameofexec] crash.tcl >@stdout
1770 } msg]
1771
1772 # Windows/ActiveState TCL returns a slightly different
1773 # error message. We map that to the expected message
1774 # so that we don't have to change all of the test
1775 # cases.
1776 if {$::tcl_platform(platform)=="windows"} {
1777 if {$msg=="child killed: unknown signal"} {
1778 set msg "child process exited abnormally"
1779 }
1780 }
1781
1782 lappend r $msg
1783}
1784
danb88e24f2013-02-23 18:58:11 +00001785proc run_ioerr_prep {} {
1786 set ::sqlite_io_error_pending 0
1787 catch {db close}
1788 catch {db2 close}
1789 catch {forcedelete test.db}
1790 catch {forcedelete test.db-journal}
1791 catch {forcedelete test2.db}
1792 catch {forcedelete test2.db-journal}
1793 set ::DB [sqlite3 db test.db; sqlite3_connection_pointer db]
1794 sqlite3_extended_result_codes $::DB $::ioerropts(-erc)
1795 if {[info exists ::ioerropts(-tclprep)]} {
1796 eval $::ioerropts(-tclprep)
1797 }
1798 if {[info exists ::ioerropts(-sqlprep)]} {
1799 execsql $::ioerropts(-sqlprep)
1800 }
1801 expr 0
1802}
1803
danielk197732554c12005-01-22 03:39:39 +00001804# Usage: do_ioerr_test <test number> <options...>
1805#
1806# This proc is used to implement test cases that check that IO errors
mistachkin1d406e02013-08-29 01:09:14 +00001807# are correctly handled. The first argument, <test number>, is an integer
danielk197732554c12005-01-22 03:39:39 +00001808# used to name the tests executed by this proc. Options are as follows:
1809#
1810# -tclprep TCL script to run to prepare test.
1811# -sqlprep SQL script to run to prepare test.
1812# -tclbody TCL script to run with IO error simulation.
1813# -sqlbody TCL script to run with IO error simulation.
1814# -exclude List of 'N' values not to test.
drh4ac285a2006-09-15 07:28:50 +00001815# -erc Use extended result codes
drhd5eb79e2007-03-15 12:17:42 +00001816# -persist Make simulated I/O errors persistent
danielk197732554c12005-01-22 03:39:39 +00001817# -start Value of 'N' to begin with (default 1)
1818#
1819# -cksum Boolean. If true, test that the database does
1820# not change during the execution of the test case.
1821#
1822proc do_ioerr_test {testname args} {
1823
danielk197732554c12005-01-22 03:39:39 +00001824 set ::ioerropts(-start) 1
1825 set ::ioerropts(-cksum) 0
drh4ac285a2006-09-15 07:28:50 +00001826 set ::ioerropts(-erc) 0
drhc2ee76c2007-01-04 14:58:14 +00001827 set ::ioerropts(-count) 100000000
drhd5eb79e2007-03-15 12:17:42 +00001828 set ::ioerropts(-persist) 1
danielk19774abd5442008-05-05 15:26:50 +00001829 set ::ioerropts(-ckrefcount) 0
danielk1977861f7452008-06-05 11:39:11 +00001830 set ::ioerropts(-restoreprng) 1
danielk197732554c12005-01-22 03:39:39 +00001831 array set ::ioerropts $args
1832
danielk197747cd39c2008-05-12 12:41:15 +00001833 # TEMPORARY: For 3.5.9, disable testing of extended result codes. There are
1834 # a couple of obscure IO errors that do not return them.
1835 set ::ioerropts(-erc) 0
mistachkin1d406e02013-08-29 01:09:14 +00001836
danb88e24f2013-02-23 18:58:11 +00001837 # Create a single TCL script from the TCL and SQL specified
1838 # as the body of the test.
1839 set ::ioerrorbody {}
1840 if {[info exists ::ioerropts(-tclbody)]} {
1841 append ::ioerrorbody "$::ioerropts(-tclbody)\n"
1842 }
1843 if {[info exists ::ioerropts(-sqlbody)]} {
1844 append ::ioerrorbody "db eval {$::ioerropts(-sqlbody)}"
1845 }
1846
1847 save_prng_state
1848 if {$::ioerropts(-cksum)} {
1849 run_ioerr_prep
1850 eval $::ioerrorbody
1851 set ::goodcksum [cksum]
1852 }
danielk197747cd39c2008-05-12 12:41:15 +00001853
danielk197732554c12005-01-22 03:39:39 +00001854 set ::go 1
drh93aed5a2008-01-16 17:46:38 +00001855 #reset_prng_state
danielk1977ef165ce2009-04-06 17:50:03 +00001856 for {set n $::ioerropts(-start)} {$::go} {incr n} {
danielk197792d4d7a2007-05-04 12:05:56 +00001857 set ::TN $n
drhc2ee76c2007-01-04 14:58:14 +00001858 incr ::ioerropts(-count) -1
1859 if {$::ioerropts(-count)<0} break
mistachkin1d406e02013-08-29 01:09:14 +00001860
danielk197732554c12005-01-22 03:39:39 +00001861 # Skip this IO error if it was specified with the "-exclude" option.
1862 if {[info exists ::ioerropts(-exclude)]} {
1863 if {[lsearch $::ioerropts(-exclude) $n]!=-1} continue
1864 }
danielk1977861f7452008-06-05 11:39:11 +00001865 if {$::ioerropts(-restoreprng)} {
1866 restore_prng_state
1867 }
danielk197732554c12005-01-22 03:39:39 +00001868
mistachkin1d406e02013-08-29 01:09:14 +00001869 # Delete the files test.db and test2.db, then execute the TCL and
danielk197732554c12005-01-22 03:39:39 +00001870 # SQL (in that order) to prepare for the test case.
1871 do_test $testname.$n.1 {
danb88e24f2013-02-23 18:58:11 +00001872 run_ioerr_prep
danielk197732554c12005-01-22 03:39:39 +00001873 } {0}
1874
1875 # Read the 'checksum' of the database.
1876 if {$::ioerropts(-cksum)} {
danb88e24f2013-02-23 18:58:11 +00001877 set ::checksum [cksum]
danielk197732554c12005-01-22 03:39:39 +00001878 }
drh93aed5a2008-01-16 17:46:38 +00001879
danielk197732554c12005-01-22 03:39:39 +00001880 # Set the Nth IO error to fail.
1881 do_test $testname.$n.2 [subst {
drhd5eb79e2007-03-15 12:17:42 +00001882 set ::sqlite_io_error_persist $::ioerropts(-persist)
danielk197732554c12005-01-22 03:39:39 +00001883 set ::sqlite_io_error_pending $n
1884 }] $n
danielk197732554c12005-01-22 03:39:39 +00001885
danb88e24f2013-02-23 18:58:11 +00001886 # Execute the TCL script created for the body of this test. If
mistachkin1d406e02013-08-29 01:09:14 +00001887 # at least N IO operations performed by SQLite as a result of
danb88e24f2013-02-23 18:58:11 +00001888 # the script, the Nth will fail.
danielk197732554c12005-01-22 03:39:39 +00001889 do_test $testname.$n.3 {
drh1aa5af12008-03-07 19:51:14 +00001890 set ::sqlite_io_error_hit 0
1891 set ::sqlite_io_error_hardhit 0
danielk197732554c12005-01-22 03:39:39 +00001892 set r [catch $::ioerrorbody msg]
drh1aa5af12008-03-07 19:51:14 +00001893 set ::errseen $r
drhe49f9822006-09-15 12:29:16 +00001894 set rc [sqlite3_errcode $::DB]
1895 if {$::ioerropts(-erc)} {
drh5f7b5bf2007-04-19 12:30:54 +00001896 # If we are in extended result code mode, make sure all of the
1897 # IOERRs we get back really do have their extended code values.
1898 # If an extended result code is returned, the sqlite3_errcode
1899 # TCLcommand will return a string of the form: SQLITE_IOERR+nnnn
1900 # where nnnn is a number
drhe49f9822006-09-15 12:29:16 +00001901 if {[regexp {^SQLITE_IOERR} $rc] && ![regexp {IOERR\+\d} $rc]} {
1902 return $rc
1903 }
1904 } else {
drh5f7b5bf2007-04-19 12:30:54 +00001905 # If we are not in extended result code mode, make sure no
1906 # extended error codes are returned.
drhe49f9822006-09-15 12:29:16 +00001907 if {[regexp {\+\d} $rc]} {
1908 return $rc
1909 }
1910 }
drh93aed5a2008-01-16 17:46:38 +00001911 # The test repeats as long as $::go is non-zero. $::go starts out
1912 # as 1. When a test runs to completion without hitting an I/O
1913 # error, that means there is no point in continuing with this test
1914 # case so set $::go to zero.
1915 #
1916 if {$::sqlite_io_error_pending>0} {
1917 set ::go 0
1918 set q 0
1919 set ::sqlite_io_error_pending 0
1920 } else {
1921 set q 1
1922 }
1923
drhc9ac5ca2005-11-04 22:03:30 +00001924 set s [expr $::sqlite_io_error_hit==0]
drh1aa5af12008-03-07 19:51:14 +00001925 if {$::sqlite_io_error_hit>$::sqlite_io_error_hardhit && $r==0} {
1926 set r 1
1927 }
danielk1977f2fa8312006-01-24 13:09:33 +00001928 set ::sqlite_io_error_hit 0
drh5f7b5bf2007-04-19 12:30:54 +00001929
1930 # One of two things must have happened. either
1931 # 1. We never hit the IO error and the SQL returned OK
1932 # 2. An IO error was hit and the SQL failed
1933 #
dand41a29a2010-05-06 15:56:28 +00001934 #puts "s=$s r=$r q=$q"
drh93aed5a2008-01-16 17:46:38 +00001935 expr { ($s && !$r && !$q) || (!$s && $r && $q) }
danielk197732554c12005-01-22 03:39:39 +00001936 } {1}
1937
danielk197780daec62008-05-12 10:57:02 +00001938 set ::sqlite_io_error_hit 0
1939 set ::sqlite_io_error_pending 0
1940
mistachkin1d406e02013-08-29 01:09:14 +00001941 # Check that no page references were leaked. There should be
1942 # a single reference if there is still an active transaction,
danielk197752b472a2008-05-05 16:23:55 +00001943 # or zero otherwise.
1944 #
danielk197781620542008-06-07 05:19:37 +00001945 # UPDATE: If the IO error occurs after a 'BEGIN' but before any
mistachkin1d406e02013-08-29 01:09:14 +00001946 # locks are established on database files (i.e. if the error
danielk197781620542008-06-07 05:19:37 +00001947 # occurs while attempting to detect a hot-journal file), then
1948 # there may 0 page references and an active transaction according
1949 # to [sqlite3_get_autocommit].
1950 #
danielk19774abd5442008-05-05 15:26:50 +00001951 if {$::go && $::sqlite_io_error_hardhit && $::ioerropts(-ckrefcount)} {
danielk19774abd5442008-05-05 15:26:50 +00001952 do_test $testname.$n.4 {
1953 set bt [btree_from_db db]
1954 db_enter db
1955 array set stats [btree_pager_stats $bt]
1956 db_leave db
danielk197781620542008-06-07 05:19:37 +00001957 set nRef $stats(ref)
1958 expr {$nRef == 0 || ([sqlite3_get_autocommit db]==0 && $nRef == 1)}
1959 } {1}
danielk19774abd5442008-05-05 15:26:50 +00001960 }
1961
mistachkin1d406e02013-08-29 01:09:14 +00001962 # If there is an open database handle and no open transaction,
danielk197752b472a2008-05-05 16:23:55 +00001963 # and the pager is not running in exclusive-locking mode,
1964 # check that the pager is in "unlocked" state. Theoretically,
1965 # if a call to xUnlock() failed due to an IO error the underlying
1966 # file may still be locked.
1967 #
1968 ifcapable pragma {
1969 if { [info commands db] ne ""
danielk19770259fbe2008-05-05 17:14:53 +00001970 && $::ioerropts(-ckrefcount)
danielk197752b472a2008-05-05 16:23:55 +00001971 && [db one {pragma locking_mode}] eq "normal"
1972 && [sqlite3_get_autocommit db]
1973 } {
1974 do_test $testname.$n.5 {
1975 set bt [btree_from_db db]
1976 db_enter db
1977 array set stats [btree_pager_stats $bt]
1978 db_leave db
1979 set stats(state)
1980 } 0
1981 }
1982 }
1983
mistachkin48864df2013-03-21 21:20:32 +00001984 # If an IO error occurred, then the checksum of the database should
danielk197732554c12005-01-22 03:39:39 +00001985 # be the same as before the script that caused the IO error was run.
danielk197752b472a2008-05-05 16:23:55 +00001986 #
drh1aa5af12008-03-07 19:51:14 +00001987 if {$::go && $::sqlite_io_error_hardhit && $::ioerropts(-cksum)} {
danielk19770259fbe2008-05-05 17:14:53 +00001988 do_test $testname.$n.6 {
danielk197732554c12005-01-22 03:39:39 +00001989 catch {db close}
danielk1977a9613392008-07-08 12:07:32 +00001990 catch {db2 close}
drha34c62d2006-01-06 22:11:20 +00001991 set ::DB [sqlite3 db test.db; sqlite3_connection_pointer db]
danb88e24f2013-02-23 18:58:11 +00001992 set nowcksum [cksum]
1993 set res [expr {$nowcksum==$::checksum || $nowcksum==$::goodcksum}]
1994 if {$res==0} {
dan17c08232015-06-09 15:58:28 +00001995 output2 "now=$nowcksum"
1996 output2 "the=$::checksum"
1997 output2 "fwd=$::goodcksum"
danb88e24f2013-02-23 18:58:11 +00001998 }
1999 set res
2000 } 1
danielk197732554c12005-01-22 03:39:39 +00002001 }
2002
drh1aa5af12008-03-07 19:51:14 +00002003 set ::sqlite_io_error_hardhit 0
danielk1977c4da5b92006-01-21 12:08:54 +00002004 set ::sqlite_io_error_pending 0
danielk1977105afed2005-05-26 15:20:53 +00002005 if {[info exists ::ioerropts(-cleanup)]} {
2006 catch $::ioerropts(-cleanup)
2007 }
danielk197732554c12005-01-22 03:39:39 +00002008 }
2009 set ::sqlite_io_error_pending 0
drh6d54da02007-03-25 19:08:46 +00002010 set ::sqlite_io_error_persist 0
danielk197732554c12005-01-22 03:39:39 +00002011 unset ::ioerropts
2012}
2013
drh93aed5a2008-01-16 17:46:38 +00002014# Return a checksum based on the contents of the main database associated
2015# with connection $db
danielk197732554c12005-01-22 03:39:39 +00002016#
2017proc cksum {{db db}} {
2018 set txt [$db eval {
2019 SELECT name, type, sql FROM sqlite_master order by name
2020 }]\n
2021 foreach tbl [$db eval {
2022 SELECT name FROM sqlite_master WHERE type='table' order by name
2023 }] {
2024 append txt [$db eval "SELECT * FROM $tbl"]\n
2025 }
2026 foreach prag {default_synchronous default_cache_size} {
2027 append txt $prag-[$db eval "PRAGMA $prag"]\n
2028 }
2029 set cksum [string length $txt]-[md5 $txt]
2030 # puts $cksum-[file size test.db]
2031 return $cksum
2032}
2033
drh93aed5a2008-01-16 17:46:38 +00002034# Generate a checksum based on the contents of the main and temp tables
2035# database $db. If the checksum of two databases is the same, and the
2036# integrity-check passes for both, the two databases are identical.
2037#
drh1db639c2008-01-17 02:36:28 +00002038proc allcksum {{db db}} {
drh93aed5a2008-01-16 17:46:38 +00002039 set ret [list]
2040 ifcapable tempdb {
2041 set sql {
2042 SELECT name FROM sqlite_master WHERE type = 'table' UNION
2043 SELECT name FROM sqlite_temp_master WHERE type = 'table' UNION
2044 SELECT 'sqlite_master' UNION
2045 SELECT 'sqlite_temp_master' ORDER BY 1
2046 }
2047 } else {
2048 set sql {
2049 SELECT name FROM sqlite_master WHERE type = 'table' UNION
2050 SELECT 'sqlite_master' ORDER BY 1
2051 }
2052 }
2053 set tbllist [$db eval $sql]
2054 set txt {}
2055 foreach tbl $tbllist {
2056 append txt [$db eval "SELECT * FROM $tbl"]
2057 }
2058 foreach prag {default_cache_size} {
2059 append txt $prag-[$db eval "PRAGMA $prag"]\n
2060 }
2061 # puts txt=$txt
2062 return [md5 $txt]
2063}
2064
drhdc2c4912009-02-04 22:46:47 +00002065# Generate a checksum based on the contents of a single database with
mistachkin1d406e02013-08-29 01:09:14 +00002066# a database connection. The name of the database is $dbname.
drhdc2c4912009-02-04 22:46:47 +00002067# Examples of $dbname are "temp" or "main".
2068#
2069proc dbcksum {db dbname} {
2070 if {$dbname=="temp"} {
2071 set master sqlite_temp_master
2072 } else {
2073 set master $dbname.sqlite_master
2074 }
2075 set alltab [$db eval "SELECT name FROM $master WHERE type='table'"]
2076 set txt [$db eval "SELECT * FROM $master"]\n
2077 foreach tab $alltab {
2078 append txt [$db eval "SELECT * FROM $dbname.$tab"]\n
2079 }
2080 return [md5 $txt]
2081}
2082
dan253c6ee2018-09-18 17:00:06 +00002083proc memdebug_log_sql {filename} {
danielk197735754ac2008-03-21 17:29:37 +00002084
danielk19776f332c12008-03-21 14:22:44 +00002085 set data [sqlite3_memdebug_log dump]
2086 set nFrame [expr [llength [lindex $data 0]]-2]
danielk19776f332c12008-03-21 14:22:44 +00002087 if {$nFrame < 0} { return "" }
2088
danielk197735754ac2008-03-21 17:29:37 +00002089 set database temp
2090
danielk19776ab3a2e2009-02-19 14:39:25 +00002091 set tbl "CREATE TABLE ${database}.malloc(zTest, nCall, nByte, lStack);"
danielk19776f332c12008-03-21 14:22:44 +00002092
2093 set sql ""
2094 foreach e $data {
danielk19776ab3a2e2009-02-19 14:39:25 +00002095 set nCall [lindex $e 0]
2096 set nByte [lindex $e 1]
2097 set lStack [lrange $e 2 end]
2098 append sql "INSERT INTO ${database}.malloc VALUES"
2099 append sql "('test', $nCall, $nByte, '$lStack');\n"
2100 foreach f $lStack {
danielk19776f332c12008-03-21 14:22:44 +00002101 set frames($f) 1
2102 }
2103 }
2104
2105 set tbl2 "CREATE TABLE ${database}.frame(frame INTEGER PRIMARY KEY, line);\n"
danielk197735754ac2008-03-21 17:29:37 +00002106 set tbl3 "CREATE TABLE ${database}.file(name PRIMARY KEY, content);\n"
danielk19776f332c12008-03-21 14:22:44 +00002107
dandee9be92019-02-05 16:53:26 +00002108 set pid [pid]
2109
danielk19776f332c12008-03-21 14:22:44 +00002110 foreach f [array names frames] {
2111 set addr [format %x $f]
dandee9be92019-02-05 16:53:26 +00002112 set cmd "eu-addr2line --pid=$pid $addr"
danielk19776f332c12008-03-21 14:22:44 +00002113 set line [eval exec $cmd]
2114 append sql "INSERT INTO ${database}.frame VALUES($f, '$line');\n"
danielk197735754ac2008-03-21 17:29:37 +00002115
2116 set file [lindex [split $line :] 0]
2117 set files($file) 1
danielk19776f332c12008-03-21 14:22:44 +00002118 }
2119
danielk197735754ac2008-03-21 17:29:37 +00002120 foreach f [array names files] {
2121 set contents ""
2122 catch {
2123 set fd [open $f]
2124 set contents [read $fd]
2125 close $fd
danielk19776f332c12008-03-21 14:22:44 +00002126 }
danielk197735754ac2008-03-21 17:29:37 +00002127 set contents [string map {' ''} $contents]
2128 append sql "INSERT INTO ${database}.file VALUES('$f', '$contents');\n"
danielk19776f332c12008-03-21 14:22:44 +00002129 }
danielk19776f332c12008-03-21 14:22:44 +00002130
dan253c6ee2018-09-18 17:00:06 +00002131 set escaped "BEGIN; ${tbl}${tbl2}${tbl3}${sql} ; COMMIT;"
2132 set escaped [string map [list "{" "\\{" "}" "\\}"] $escaped]
2133
danielk197735754ac2008-03-21 17:29:37 +00002134 set fd [open $filename w]
dan253c6ee2018-09-18 17:00:06 +00002135 puts $fd "set BUILTIN {"
2136 puts $fd $escaped
2137 puts $fd "}"
2138 puts $fd {set BUILTIN [string map [list "\\{" "{" "\\}" "}"] $BUILTIN]}
2139 set mtv [open $::testdir/malloctraceviewer.tcl]
2140 set txt [read $mtv]
2141 close $mtv
2142 puts $fd $txt
danielk197735754ac2008-03-21 17:29:37 +00002143 close $fd
danielk19776f332c12008-03-21 14:22:44 +00002144}
drh93aed5a2008-01-16 17:46:38 +00002145
danf5894502009-10-07 18:41:19 +00002146# Drop all tables in database [db]
2147proc drop_all_tables {{db db}} {
shaneh4e7b32f2009-12-17 22:12:51 +00002148 ifcapable trigger&&foreignkey {
2149 set pk [$db one "PRAGMA foreign_keys"]
2150 $db eval "PRAGMA foreign_keys = OFF"
2151 }
drh9a6ffc82010-02-15 18:03:20 +00002152 foreach {idx name file} [db eval {PRAGMA database_list}] {
2153 if {$idx==1} {
2154 set master sqlite_temp_master
2155 } else {
2156 set master $name.sqlite_master
2157 }
2158 foreach {t type} [$db eval "
2159 SELECT name, type FROM $master
dana16d1062010-09-28 17:37:28 +00002160 WHERE type IN('table', 'view') AND name NOT LIKE 'sqliteX_%' ESCAPE 'X'
drh9a6ffc82010-02-15 18:03:20 +00002161 "] {
dana16d1062010-09-28 17:37:28 +00002162 $db eval "DROP $type \"$t\""
drh9a6ffc82010-02-15 18:03:20 +00002163 }
danf5894502009-10-07 18:41:19 +00002164 }
shaneh4e7b32f2009-12-17 22:12:51 +00002165 ifcapable trigger&&foreignkey {
2166 $db eval "PRAGMA foreign_keys = $pk"
2167 }
danf5894502009-10-07 18:41:19 +00002168}
2169
dand05a7142016-08-02 17:07:51 +00002170# Drop all auxiliary indexes from the main database opened by handle [db].
2171#
2172proc drop_all_indexes {{db db}} {
2173 set L [$db eval {
2174 SELECT name FROM sqlite_master WHERE type='index' AND sql LIKE 'create%'
2175 }]
2176 foreach idx $L { $db eval "DROP INDEX $idx" }
2177}
2178
2179
dan71cb5182010-04-26 12:39:03 +00002180#-------------------------------------------------------------------------
dan430e74c2010-06-07 17:47:26 +00002181# If a test script is executed with global variable $::G(perm:name) set to
mistachkin1d406e02013-08-29 01:09:14 +00002182# "wal", then the tests are run in WAL mode. Otherwise, they should be run
2183# in rollback mode. The following Tcl procs are used to make this less
dan430e74c2010-06-07 17:47:26 +00002184# intrusive:
dan71cb5182010-04-26 12:39:03 +00002185#
2186# wal_set_journal_mode ?DB?
2187#
2188# If running a WAL test, execute "PRAGMA journal_mode = wal" using
2189# connection handle DB. Otherwise, this command is a no-op.
2190#
2191# wal_check_journal_mode TESTNAME ?DB?
2192#
2193# If running a WAL test, execute a tests case that fails if the main
2194# database for connection handle DB is not currently a WAL database.
2195# Otherwise (if not running a WAL permutation) this is a no-op.
2196#
2197# wal_is_wal_mode
mistachkin1d406e02013-08-29 01:09:14 +00002198#
dan71cb5182010-04-26 12:39:03 +00002199# Returns true if this test should be run in WAL mode. False otherwise.
mistachkin1d406e02013-08-29 01:09:14 +00002200#
dan71cb5182010-04-26 12:39:03 +00002201proc wal_is_wal_mode {} {
dan430e74c2010-06-07 17:47:26 +00002202 expr {[permutation] eq "wal"}
dan71cb5182010-04-26 12:39:03 +00002203}
2204proc wal_set_journal_mode {{db db}} {
2205 if { [wal_is_wal_mode] } {
2206 $db eval "PRAGMA journal_mode = WAL"
2207 }
2208}
2209proc wal_check_journal_mode {testname {db db}} {
2210 if { [wal_is_wal_mode] } {
2211 $db eval { SELECT * FROM sqlite_master }
2212 do_test $testname [list $db eval "PRAGMA main.journal_mode"] {wal}
2213 }
2214}
2215
dan05accd22016-04-27 18:54:49 +00002216proc wal_is_capable {} {
2217 ifcapable !wal { return 0 }
2218 if {[permutation]=="journaltest"} { return 0 }
2219 return 1
2220}
2221
dan430e74c2010-06-07 17:47:26 +00002222proc permutation {} {
2223 set perm ""
2224 catch {set perm $::G(perm:name)}
2225 set perm
2226}
dancb79e512010-08-06 13:50:07 +00002227proc presql {} {
2228 set presql ""
2229 catch {set presql $::G(perm:presql)}
2230 set presql
2231}
dan430e74c2010-06-07 17:47:26 +00002232
danbe7721d2016-02-04 17:31:03 +00002233proc isquick {} {
2234 set ret 0
2235 catch {set ret $::G(isquick)}
2236 set ret
2237}
2238
danc1a60c52010-06-07 14:28:16 +00002239#-------------------------------------------------------------------------
2240#
2241proc slave_test_script {script} {
2242
2243 # Create the interpreter used to run the test script.
2244 interp create tinterp
2245
2246 # Populate some global variables that tester.tcl expects to see.
2247 foreach {var value} [list \
2248 ::argv0 $::argv0 \
2249 ::argv {} \
2250 ::SLAVE 1 \
2251 ] {
2252 interp eval tinterp [list set $var $value]
2253 }
2254
dan17c08232015-06-09 15:58:28 +00002255 # If output is being copied into a file, share the file-descriptor with
2256 # the interpreter.
2257 if {[info exists ::G(output_fd)]} {
2258 interp share {} $::G(output_fd) tinterp
2259 }
2260
danc1a60c52010-06-07 14:28:16 +00002261 # The alias used to access the global test counters.
2262 tinterp alias set_test_counter set_test_counter
2263
2264 # Set up the ::cmdlinearg array in the slave.
2265 interp eval tinterp [list array set ::cmdlinearg [array get ::cmdlinearg]]
2266
dan430e74c2010-06-07 17:47:26 +00002267 # Set up the ::G array in the slave.
2268 interp eval tinterp [list array set ::G [array get ::G]]
2269
danc1a60c52010-06-07 14:28:16 +00002270 # Load the various test interfaces implemented in C.
2271 load_testfixture_extensions tinterp
2272
2273 # Run the test script.
2274 interp eval tinterp $script
2275
danea5542d2010-07-06 11:26:15 +00002276 # Check if the interpreter call [run_thread_tests]
2277 if { [interp eval tinterp {info exists ::run_thread_tests_called}] } {
2278 set ::run_thread_tests_called 1
2279 }
2280
danc1a60c52010-06-07 14:28:16 +00002281 # Delete the interpreter used to run the test script.
2282 interp delete tinterp
2283}
2284
dan430e74c2010-06-07 17:47:26 +00002285proc slave_test_file {zFile} {
dan0626dfc2010-06-15 06:56:37 +00002286 set tail [file tail $zFile]
dan430e74c2010-06-07 17:47:26 +00002287
dan6a64d672011-04-04 15:38:16 +00002288 if {[info exists ::G(start:permutation)]} {
2289 if {[permutation] != $::G(start:permutation)} return
2290 unset ::G(start:permutation)
2291 }
2292 if {[info exists ::G(start:file)]} {
2293 if {$tail != $::G(start:file) && $tail!="$::G(start:file).test"} return
2294 unset ::G(start:file)
2295 }
2296
dan92d516a2010-07-05 14:54:48 +00002297 # Remember the value of the shared-cache setting. So that it is possible
2298 # to check afterwards that it was not modified by the test script.
2299 #
2300 ifcapable shared_cache { set scs [sqlite3_enable_shared_cache] }
dan0626dfc2010-06-15 06:56:37 +00002301
dan92d516a2010-07-05 14:54:48 +00002302 # Run the test script in a slave interpreter.
2303 #
danea5542d2010-07-06 11:26:15 +00002304 unset -nocomplain ::run_thread_tests_called
dan0626dfc2010-06-15 06:56:37 +00002305 reset_prng_state
2306 set ::sqlite_open_file_count 0
2307 set time [time { slave_test_script [list source $zFile] }]
2308 set ms [expr [lindex $time 0] / 1000]
2309
dan92d516a2010-07-05 14:54:48 +00002310 # Test that all files opened by the test script were closed. Omit this
2311 # if the test script has "thread" in its name. The open file counter
2312 # is not thread-safe.
dan0626dfc2010-06-15 06:56:37 +00002313 #
danea5542d2010-07-06 11:26:15 +00002314 if {[info exists ::run_thread_tests_called]==0} {
dan92d516a2010-07-05 14:54:48 +00002315 do_test ${tail}-closeallfiles { expr {$::sqlite_open_file_count>0} } {0}
2316 }
dan430e74c2010-06-07 17:47:26 +00002317 set ::sqlite_open_file_count 0
2318
mistachkin1d406e02013-08-29 01:09:14 +00002319 # Test that the global "shared-cache" setting was not altered by
dan0626dfc2010-06-15 06:56:37 +00002320 # the test script.
2321 #
mistachkin1d406e02013-08-29 01:09:14 +00002322 ifcapable shared_cache {
dan0626dfc2010-06-15 06:56:37 +00002323 set res [expr {[sqlite3_enable_shared_cache] == $scs}]
2324 do_test ${tail}-sharedcachesetting [list set {} $res] 1
2325 }
dan430e74c2010-06-07 17:47:26 +00002326
dan92d516a2010-07-05 14:54:48 +00002327 # Add some info to the output.
2328 #
dan17c08232015-06-09 15:58:28 +00002329 output2 "Time: $tail $ms ms"
dan430e74c2010-06-07 17:47:26 +00002330 show_memstats
danc1a60c52010-06-07 14:28:16 +00002331}
2332
dan59257dc2010-08-04 11:34:31 +00002333# Open a new connection on database test.db and execute the SQL script
2334# supplied as an argument. Before returning, close the new conection and
2335# restore the 4 byte fields starting at header offsets 28, 92 and 96
2336# to the values they held before the SQL was executed. This simulates
2337# a write by a pre-3.7.0 client.
2338#
2339proc sql36231 {sql} {
2340 set B [hexio_read test.db 92 8]
2341 set A [hexio_read test.db 28 4]
2342 sqlite3 db36231 test.db
2343 catch { db36231 func a_string a_string }
2344 execsql $sql db36231
2345 db36231 close
2346 hexio_write test.db 28 $A
2347 hexio_write test.db 92 $B
2348 return ""
2349}
danf5894502009-10-07 18:41:19 +00002350
danccc7ff42010-11-29 12:06:45 +00002351proc db_save {} {
2352 foreach f [glob -nocomplain sv_test.db*] { forcedelete $f }
2353 foreach f [glob -nocomplain test.db*] {
2354 set f2 "sv_$f"
mistachkinfda06be2011-08-02 00:57:34 +00002355 forcecopy $f $f2
danccc7ff42010-11-29 12:06:45 +00002356 }
2357}
2358proc db_save_and_close {} {
2359 db_save
2360 catch { db close }
2361 return ""
2362}
2363proc db_restore {} {
2364 foreach f [glob -nocomplain test.db*] { forcedelete $f }
2365 foreach f2 [glob -nocomplain sv_test.db*] {
2366 set f [string range $f2 3 end]
mistachkinfda06be2011-08-02 00:57:34 +00002367 forcecopy $f2 $f
danccc7ff42010-11-29 12:06:45 +00002368 }
2369}
2370proc db_restore_and_reopen {{dbfile test.db}} {
2371 catch { db close }
2372 db_restore
2373 sqlite3 db $dbfile
2374}
2375proc db_delete_and_reopen {{file test.db}} {
2376 catch { db close }
mistachkinfda06be2011-08-02 00:57:34 +00002377 foreach f [glob -nocomplain test.db*] { forcedelete $f }
danccc7ff42010-11-29 12:06:45 +00002378 sqlite3 db $file
2379}
2380
dan03bc5252015-07-24 14:17:17 +00002381# Close any connections named [db], [db2] or [db3]. Then use sqlite3_config
2382# to configure the size of the PAGECACHE allocation using the parameters
2383# provided to this command. Save the old PAGECACHE parameters in a global
2384# variable so that [test_restore_config_pagecache] can restore the previous
2385# configuration.
2386#
2387# Before returning, reopen connection [db] on file test.db.
2388#
2389proc test_set_config_pagecache {sz nPg} {
2390 catch {db close}
2391 catch {db2 close}
2392 catch {db3 close}
2393
2394 sqlite3_shutdown
2395 set ::old_pagecache_config [sqlite3_config_pagecache $sz $nPg]
2396 sqlite3_initialize
2397 autoinstall_test_functions
dand716c392015-07-24 18:22:29 +00002398 reset_db
dan03bc5252015-07-24 14:17:17 +00002399}
2400
2401# Close any connections named [db], [db2] or [db3]. Then use sqlite3_config
2402# to configure the size of the PAGECACHE allocation to the size saved in
2403# the global variable by an earlier call to [test_set_config_pagecache].
2404#
2405# Before returning, reopen connection [db] on file test.db.
2406#
2407proc test_restore_config_pagecache {} {
2408 catch {db close}
2409 catch {db2 close}
2410 catch {db3 close}
2411
2412 sqlite3_shutdown
2413 eval sqlite3_config_pagecache $::old_pagecache_config
2414 unset ::old_pagecache_config
2415 sqlite3_initialize
2416 autoinstall_test_functions
2417 sqlite3 db test.db
2418}
2419
dan43efc182017-12-19 17:42:13 +00002420proc test_binary_name {nm} {
dan089555c2016-03-15 09:55:44 +00002421 if {$::tcl_platform(platform)=="windows"} {
dan1e8dae02016-03-19 14:53:36 +00002422 set ret "$nm.exe"
dan089555c2016-03-15 09:55:44 +00002423 } else {
dan1e8dae02016-03-19 14:53:36 +00002424 set ret $nm
dan089555c2016-03-15 09:55:44 +00002425 }
dan43efc182017-12-19 17:42:13 +00002426 file normalize [file join $::cmdlinearg(TESTFIXTURE_HOME) $ret]
2427}
2428
2429proc test_find_binary {nm} {
2430 set ret [test_binary_name $nm]
dan089555c2016-03-15 09:55:44 +00002431 if {![file executable $ret]} {
2432 finish_test
dan49aed582016-03-19 15:13:59 +00002433 return ""
dan089555c2016-03-15 09:55:44 +00002434 }
2435 return $ret
2436}
2437
danielk197745901d62004-11-10 15:27:38 +00002438# Find the name of the 'shell' executable (e.g. "sqlite3.exe") to use for
2439# the tests in shell[1-5].test. If no such executable can be found, invoke
2440# [finish_test ; return] in the callers context.
danielk1977ee8b7992009-03-26 17:13:06 +00002441#
dan64b95bb2012-05-12 05:30:29 +00002442proc test_find_cli {} {
danf27d7372016-03-19 17:48:12 +00002443 set prog [test_find_binary sqlite3]
dan49aed582016-03-19 15:13:59 +00002444 if {$prog==""} { return -code return }
2445 return $prog
drh348784e2000-05-29 20:41:49 +00002446}
2447
dan1e8dae02016-03-19 14:53:36 +00002448# Find the name of the 'sqldiff' executable (e.g. "sqlite3.exe") to use for
2449# the tests in sqldiff tests. If no such executable can be found, invoke
2450# [finish_test ; return] in the callers context.
2451#
2452proc test_find_sqldiff {} {
dan49aed582016-03-19 15:13:59 +00002453 set prog [test_find_binary sqldiff]
2454 if {$prog==""} { return -code return }
2455 return $prog
dan1e8dae02016-03-19 14:53:36 +00002456}
2457
daneab0e102018-02-07 18:02:50 +00002458# Call sqlite3_expanded_sql() on all statements associated with database
2459# connection $db. This sometimes finds use-after-free bugs if run with
2460# valgrind or address-sanitizer.
2461proc expand_all_sql {db} {
2462 set stmt ""
2463 while {[set stmt [sqlite3_next_stmt $db $stmt]]!=""} {
2464 sqlite3_expanded_sql $stmt
2465 }
2466}
2467
dan1e8dae02016-03-19 14:53:36 +00002468
drh348784e2000-05-29 20:41:49 +00002469# If the library is compiled with the SQLITE_DEFAULT_AUTOVACUUM macro set
2470# to non-zero, then set the global variable $AUTOVACUUM to 1.
2471set AUTOVACUUM $sqlite_options(default_autovacuum)
2472
dan64b95bb2012-05-12 05:30:29 +00002473# Make sure the FTS enhanced query syntax is disabled.
2474set sqlite_fts3_enable_parentheses 0
2475
drh348784e2000-05-29 20:41:49 +00002476# During testing, assume that all database files are well-formed. The
2477# few test cases that deliberately corrupt database files should rescind
2478# this setting by invoking "database_can_be_corrupt"
2479#
2480database_never_corrupt
2481
drh348784e2000-05-29 20:41:49 +00002482source $testdir/thread_common.tcl
2483source $testdir/malloc_common.tcl