OLD | NEW |
1 # 2001 September 15 | 1 # 2001 September 15 |
2 # | 2 # |
3 # The author disclaims copyright to this source code. In place of | 3 # The author disclaims copyright to this source code. In place of |
4 # a legal notice, here is a blessing: | 4 # a legal notice, here is a blessing: |
5 # | 5 # |
6 # May you do good and not evil. | 6 # May you do good and not evil. |
7 # May you find forgiveness for yourself and forgive others. | 7 # May you find forgiveness for yourself and forgive others. |
8 # May you share freely, never taking more than you give. | 8 # May you share freely, never taking more than you give. |
9 # | 9 # |
10 #*********************************************************************** | 10 #*********************************************************************** |
11 # This file implements some common TCL routines used for regression | 11 # This file implements some common TCL routines used for regression |
12 # testing the SQLite library | 12 # testing the SQLite library |
13 # | 13 # |
14 # $Id: tester.tcl,v 1.143 2009/04/09 01:23:49 drh Exp $ | 14 # $Id: tester.tcl,v 1.143 2009/04/09 01:23:49 drh Exp $ |
15 | 15 |
16 #------------------------------------------------------------------------- | 16 #------------------------------------------------------------------------- |
17 # The commands provided by the code in this file to help with creating | 17 # The commands provided by the code in this file to help with creating |
18 # test cases are as follows: | 18 # test cases are as follows: |
19 # | 19 # |
20 # Commands to manipulate the db and the file-system at a high level: | 20 # Commands to manipulate the db and the file-system at a high level: |
21 # | 21 # |
22 # is_relative_file | 22 # is_relative_file |
23 # test_pwd | 23 # test_pwd |
24 # get_pwd | 24 # get_pwd |
25 # copy_file FROM TO | 25 # copy_file FROM TO |
26 # delete_file FILENAME | 26 # delete_file FILENAME |
27 # drop_all_tables ?DB? | 27 # drop_all_tables ?DB? |
| 28 # drop_all_indexes ?DB? |
28 # forcecopy FROM TO | 29 # forcecopy FROM TO |
29 # forcedelete FILENAME | 30 # forcedelete FILENAME |
30 # | 31 # |
31 # Test the capability of the SQLite version built into the interpreter to | 32 # Test the capability of the SQLite version built into the interpreter to |
32 # determine if a specific test can be run: | 33 # determine if a specific test can be run: |
33 # | 34 # |
34 # capable EXPR | 35 # capable EXPR |
35 # ifcapable EXPR | 36 # ifcapable EXPR |
36 # | 37 # |
37 # Calulate checksums based on database contents: | 38 # Calulate checksums based on database contents: |
(...skipping 328 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
366 } | 367 } |
367 } | 368 } |
368 | 369 |
369 # This command should be called after loading tester.tcl from within | 370 # This command should be called after loading tester.tcl from within |
370 # all test scripts that are incompatible with encryption codecs. | 371 # all test scripts that are incompatible with encryption codecs. |
371 # | 372 # |
372 proc do_not_use_codec {} { | 373 proc do_not_use_codec {} { |
373 set ::do_not_use_codec 1 | 374 set ::do_not_use_codec 1 |
374 reset_db | 375 reset_db |
375 } | 376 } |
| 377 unset -nocomplain do_not_use_codec |
| 378 |
| 379 # Return true if the "reserved_bytes" integer on database files is non-zero. |
| 380 # |
| 381 proc nonzero_reserved_bytes {} { |
| 382 return [sqlite3 -has-codec] |
| 383 } |
| 384 |
| 385 # Print a HELP message and exit |
| 386 # |
| 387 proc 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 |
| 391 --maxerror=N Quit after N errors |
| 392 --verbose=(0|1) Control the amount of output. Default '1' |
| 393 --output=FILE set --verbose=2 and output to FILE. Implies -q |
| 394 -q Shorthand for --verbose=0 |
| 395 --help This message |
| 396 } |
| 397 exit 1 |
| 398 } |
376 | 399 |
377 # The following block only runs the first time this file is sourced. It | 400 # The following block only runs the first time this file is sourced. It |
378 # does not run in slave interpreters (since the ::cmdlinearg array is | 401 # does not run in slave interpreters (since the ::cmdlinearg array is |
379 # populated before the test script is run in slave interpreters). | 402 # populated before the test script is run in slave interpreters). |
380 # | 403 # |
381 if {[info exists cmdlinearg]==0} { | 404 if {[info exists cmdlinearg]==0} { |
382 | 405 |
383 # Parse any options specified in the $argv array. This script accepts the | 406 # Parse any options specified in the $argv array. This script accepts the |
384 # following options: | 407 # following options: |
385 # | 408 # |
386 # --pause | 409 # --pause |
387 # --soft-heap-limit=NN | 410 # --soft-heap-limit=NN |
388 # --maxerror=NN | 411 # --maxerror=NN |
389 # --malloctrace=N | 412 # --malloctrace=N |
390 # --backtrace=N | 413 # --backtrace=N |
391 # --binarylog=N | 414 # --binarylog=N |
392 # --soak=N | 415 # --soak=N |
393 # --file-retries=N | 416 # --file-retries=N |
394 # --file-retry-delay=N | 417 # --file-retry-delay=N |
395 # --start=[$permutation:]$testfile | 418 # --start=[$permutation:]$testfile |
396 # --match=$pattern | 419 # --match=$pattern |
397 # --verbose=$val | 420 # --verbose=$val |
398 # --output=$filename | 421 # --output=$filename |
| 422 # -q Reduce output |
| 423 # --testdir=$dir Run tests in subdirectory $dir |
399 # --help | 424 # --help |
400 # | 425 # |
401 set cmdlinearg(soft-heap-limit) 0 | 426 set cmdlinearg(soft-heap-limit) 0 |
402 set cmdlinearg(maxerror) 1000 | 427 set cmdlinearg(maxerror) 1000 |
403 set cmdlinearg(malloctrace) 0 | 428 set cmdlinearg(malloctrace) 0 |
404 set cmdlinearg(backtrace) 10 | 429 set cmdlinearg(backtrace) 10 |
405 set cmdlinearg(binarylog) 0 | 430 set cmdlinearg(binarylog) 0 |
406 set cmdlinearg(soak) 0 | 431 set cmdlinearg(soak) 0 |
407 set cmdlinearg(file-retries) 0 | 432 set cmdlinearg(file-retries) 0 |
408 set cmdlinearg(file-retry-delay) 0 | 433 set cmdlinearg(file-retry-delay) 0 |
409 set cmdlinearg(start) "" | 434 set cmdlinearg(start) "" |
410 set cmdlinearg(match) "" | 435 set cmdlinearg(match) "" |
411 set cmdlinearg(verbose) "" | 436 set cmdlinearg(verbose) "" |
412 set cmdlinearg(output) "" | 437 set cmdlinearg(output) "" |
| 438 set cmdlinearg(testdir) "testdir" |
413 | 439 |
414 set leftover [list] | 440 set leftover [list] |
415 foreach a $argv { | 441 foreach a $argv { |
416 switch -regexp -- $a { | 442 switch -regexp -- $a { |
417 {^-+pause$} { | 443 {^-+pause$} { |
418 # Wait for user input before continuing. This is to give the user an | 444 # Wait for user input before continuing. This is to give the user an |
419 # opportunity to connect profiling tools to the process. | 445 # opportunity to connect profiling tools to the process. |
420 puts -nonewline "Press RETURN to begin..." | 446 puts -nonewline "Press RETURN to begin..." |
421 flush stdout | 447 flush stdout |
422 gets stdin | 448 gets stdin |
423 } | 449 } |
424 {^-+soft-heap-limit=.+$} { | 450 {^-+soft-heap-limit=.+$} { |
425 foreach {dummy cmdlinearg(soft-heap-limit)} [split $a =] break | 451 foreach {dummy cmdlinearg(soft-heap-limit)} [split $a =] break |
426 } | 452 } |
427 {^-+maxerror=.+$} { | 453 {^-+maxerror=.+$} { |
428 foreach {dummy cmdlinearg(maxerror)} [split $a =] break | 454 foreach {dummy cmdlinearg(maxerror)} [split $a =] break |
429 } | 455 } |
430 {^-+malloctrace=.+$} { | 456 {^-+malloctrace=.+$} { |
431 foreach {dummy cmdlinearg(malloctrace)} [split $a =] break | 457 foreach {dummy cmdlinearg(malloctrace)} [split $a =] break |
432 if {$cmdlinearg(malloctrace)} { | 458 if {$cmdlinearg(malloctrace)} { |
433 sqlite3_memdebug_log start | 459 sqlite3_memdebug_log start |
434 } | 460 } |
435 } | 461 } |
436 {^-+backtrace=.+$} { | 462 {^-+backtrace=.+$} { |
437 foreach {dummy cmdlinearg(backtrace)} [split $a =] break | 463 foreach {dummy cmdlinearg(backtrace)} [split $a =] break |
438 sqlite3_memdebug_backtrace $value | 464 sqlite3_memdebug_backtrace $cmdlinearg(backtrace) |
439 } | 465 } |
440 {^-+binarylog=.+$} { | 466 {^-+binarylog=.+$} { |
441 foreach {dummy cmdlinearg(binarylog)} [split $a =] break | 467 foreach {dummy cmdlinearg(binarylog)} [split $a =] break |
| 468 set cmdlinearg(binarylog) [file normalize $cmdlinearg(binarylog)] |
442 } | 469 } |
443 {^-+soak=.+$} { | 470 {^-+soak=.+$} { |
444 foreach {dummy cmdlinearg(soak)} [split $a =] break | 471 foreach {dummy cmdlinearg(soak)} [split $a =] break |
445 set ::G(issoak) $cmdlinearg(soak) | 472 set ::G(issoak) $cmdlinearg(soak) |
446 } | 473 } |
447 {^-+file-retries=.+$} { | 474 {^-+file-retries=.+$} { |
448 foreach {dummy cmdlinearg(file-retries)} [split $a =] break | 475 foreach {dummy cmdlinearg(file-retries)} [split $a =] break |
449 set ::G(file-retries) $cmdlinearg(file-retries) | 476 set ::G(file-retries) $cmdlinearg(file-retries) |
450 } | 477 } |
451 {^-+file-retry-delay=.+$} { | 478 {^-+file-retry-delay=.+$} { |
(...skipping 12 matching lines...) Expand all Loading... |
464 } | 491 } |
465 {^-+match=.+$} { | 492 {^-+match=.+$} { |
466 foreach {dummy cmdlinearg(match)} [split $a =] break | 493 foreach {dummy cmdlinearg(match)} [split $a =] break |
467 | 494 |
468 set ::G(match) $cmdlinearg(match) | 495 set ::G(match) $cmdlinearg(match) |
469 if {$::G(match) == ""} {unset ::G(match)} | 496 if {$::G(match) == ""} {unset ::G(match)} |
470 } | 497 } |
471 | 498 |
472 {^-+output=.+$} { | 499 {^-+output=.+$} { |
473 foreach {dummy cmdlinearg(output)} [split $a =] break | 500 foreach {dummy cmdlinearg(output)} [split $a =] break |
| 501 set cmdlinearg(output) [file normalize $cmdlinearg(output)] |
474 if {$cmdlinearg(verbose)==""} { | 502 if {$cmdlinearg(verbose)==""} { |
475 set cmdlinearg(verbose) 2 | 503 set cmdlinearg(verbose) 2 |
476 } | 504 } |
477 } | 505 } |
478 {^-+verbose=.+$} { | 506 {^-+verbose=.+$} { |
479 foreach {dummy cmdlinearg(verbose)} [split $a =] break | 507 foreach {dummy cmdlinearg(verbose)} [split $a =] break |
480 if {$cmdlinearg(verbose)=="file"} { | 508 if {$cmdlinearg(verbose)=="file"} { |
481 set cmdlinearg(verbose) 2 | 509 set cmdlinearg(verbose) 2 |
482 } elseif {[string is boolean -strict $cmdlinearg(verbose)]==0} { | 510 } elseif {[string is boolean -strict $cmdlinearg(verbose)]==0} { |
483 error "option --verbose= must be set to a boolean or to \"file\"" | 511 error "option --verbose= must be set to a boolean or to \"file\"" |
484 } | 512 } |
485 } | 513 } |
| 514 {^-+testdir=.*$} { |
| 515 foreach {dummy cmdlinearg(testdir)} [split $a =] break |
| 516 } |
| 517 {.*help.*} { |
| 518 print_help_and_quit |
| 519 } |
| 520 {^-q$} { |
| 521 set cmdlinearg(output) test-out.txt |
| 522 set cmdlinearg(verbose) 2 |
| 523 } |
486 | 524 |
487 default { | 525 default { |
488 lappend leftover $a | 526 if {[file tail $a]==$a} { |
| 527 lappend leftover $a |
| 528 } else { |
| 529 lappend leftover [file normalize $a] |
| 530 } |
489 } | 531 } |
490 } | 532 } |
491 } | 533 } |
| 534 set testdir [file normalize $testdir] |
| 535 set cmdlinearg(TESTFIXTURE_HOME) [pwd] |
| 536 set cmdlinearg(INFO_SCRIPT) [file normalize [info script]] |
| 537 set argv0 [file normalize $argv0] |
| 538 if {$cmdlinearg(testdir)!=""} { |
| 539 file mkdir $cmdlinearg(testdir) |
| 540 cd $cmdlinearg(testdir) |
| 541 } |
492 set argv $leftover | 542 set argv $leftover |
493 | 543 |
494 # Install the malloc layer used to inject OOM errors. And the 'automatic' | 544 # Install the malloc layer used to inject OOM errors. And the 'automatic' |
495 # extensions. This only needs to be done once for the process. | 545 # extensions. This only needs to be done once for the process. |
496 # | 546 # |
497 sqlite3_shutdown | 547 sqlite3_shutdown |
498 install_malloc_faultsim 1 | 548 install_malloc_faultsim 1 |
499 sqlite3_initialize | 549 sqlite3_initialize |
500 autoinstall_test_functions | 550 autoinstall_test_functions |
501 | 551 |
(...skipping 163 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
665 # A channel was explicitly specified. | 715 # A channel was explicitly specified. |
666 uplevel puts_original $args | 716 uplevel puts_original $args |
667 } | 717 } |
668 } | 718 } |
669 rename puts puts_original | 719 rename puts puts_original |
670 proc puts {args} { uplevel puts_override $args } | 720 proc puts {args} { uplevel puts_override $args } |
671 | 721 |
672 | 722 |
673 # Invoke the do_test procedure to run a single test | 723 # Invoke the do_test procedure to run a single test |
674 # | 724 # |
| 725 # The $expected parameter is the expected result. The result is the return |
| 726 # value from the last TCL command in $cmd. |
| 727 # |
| 728 # Normally, $expected must match exactly. But if $expected is of the form |
| 729 # "/regexp/" then regular expression matching is used. If $expected is |
| 730 # "~/regexp/" then the regular expression must NOT match. If $expected is |
| 731 # of the form "#/value-list/" then each term in value-list must be numeric |
| 732 # and must approximately match the corresponding numeric term in $result. |
| 733 # Values must match within 10%. Or if the $expected term is A..B then the |
| 734 # $result term must be in between A and B. |
| 735 # |
675 proc do_test {name cmd expected} { | 736 proc do_test {name cmd expected} { |
676 global argv cmdlinearg | 737 global argv cmdlinearg |
677 | 738 |
678 fix_testname name | 739 fix_testname name |
679 | 740 |
680 sqlite3_memdebug_settitle $name | 741 sqlite3_memdebug_settitle $name |
681 | 742 |
682 # if {[llength $argv]==0} { | 743 # if {[llength $argv]==0} { |
683 # set go 1 | 744 # set go 1 |
684 # } else { | 745 # } else { |
(...skipping 13 matching lines...) Expand all Loading... |
698 incr_ntest | 759 incr_ntest |
699 output1 -nonewline $name... | 760 output1 -nonewline $name... |
700 flush stdout | 761 flush stdout |
701 | 762 |
702 if {![info exists ::G(match)] || [string match $::G(match) $name]} { | 763 if {![info exists ::G(match)] || [string match $::G(match) $name]} { |
703 if {[catch {uplevel #0 "$cmd;\n"} result]} { | 764 if {[catch {uplevel #0 "$cmd;\n"} result]} { |
704 output2_if_no_verbose -nonewline $name... | 765 output2_if_no_verbose -nonewline $name... |
705 output2 "\nError: $result" | 766 output2 "\nError: $result" |
706 fail_test $name | 767 fail_test $name |
707 } else { | 768 } else { |
708 if {[regexp {^~?/.*/$} $expected]} { | 769 if {[regexp {^[~#]?/.*/$} $expected]} { |
709 # "expected" is of the form "/PATTERN/" then the result if correct if | 770 # "expected" is of the form "/PATTERN/" then the result if correct if |
710 # regular expression PATTERN matches the result. "~/PATTERN/" means | 771 # regular expression PATTERN matches the result. "~/PATTERN/" means |
711 # the regular expression must not match. | 772 # the regular expression must not match. |
712 if {[string index $expected 0]=="~"} { | 773 if {[string index $expected 0]=="~"} { |
713 set re [string range $expected 2 end-1] | 774 set re [string range $expected 2 end-1] |
714 if {[string index $re 0]=="*"} { | 775 if {[string index $re 0]=="*"} { |
715 # If the regular expression begins with * then treat it as a glob in
stead | 776 # If the regular expression begins with * then treat it as a glob in
stead |
716 set ok [string match $re $result] | 777 set ok [string match $re $result] |
717 } else { | 778 } else { |
718 set re [string map {# {[-0-9.]+}} $re] | 779 set re [string map {# {[-0-9.]+}} $re] |
719 set ok [regexp $re $result] | 780 set ok [regexp $re $result] |
720 } | 781 } |
721 set ok [expr {!$ok}] | 782 set ok [expr {!$ok}] |
| 783 } elseif {[string index $expected 0]=="#"} { |
| 784 # Numeric range value comparison. Each term of the $result is matched |
| 785 # against one term of $expect. Both $result and $expected terms must
be |
| 786 # numeric. The values must match within 10%. Or if $expected is of t
he |
| 787 # form A..B then the $result term must be between A and B. |
| 788 set e2 [string range $expected 2 end-1] |
| 789 foreach i $result j $e2 { |
| 790 if {[regexp {^(-?\d+)\.\.(-?\d)$} $j all A B]} { |
| 791 set ok [expr {$i+0>=$A && $i+0<=$B}] |
| 792 } else { |
| 793 set ok [expr {$i+0>=0.9*$j && $i+0<=1.1*$j}] |
| 794 } |
| 795 if {!$ok} break |
| 796 } |
| 797 if {$ok && [llength $result]!=[llength $e2]} {set ok 0} |
722 } else { | 798 } else { |
723 set re [string range $expected 1 end-1] | 799 set re [string range $expected 1 end-1] |
724 if {[string index $re 0]=="*"} { | 800 if {[string index $re 0]=="*"} { |
725 # If the regular expression begins with * then treat it as a glob in
stead | 801 # If the regular expression begins with * then treat it as a glob in
stead |
726 set ok [string match $re $result] | 802 set ok [string match $re $result] |
727 } else { | 803 } else { |
728 set re [string map {# {[-0-9.]+}} $re] | 804 set re [string map {# {[-0-9.]+}} $re] |
729 set ok [regexp $re $result] | 805 set ok [regexp $re $result] |
730 } | 806 } |
731 } | 807 } |
(...skipping 98 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
830 | 906 |
831 proc fix_testname {varname} { | 907 proc fix_testname {varname} { |
832 upvar $varname testname | 908 upvar $varname testname |
833 if {[info exists ::testprefix] | 909 if {[info exists ::testprefix] |
834 && [string is digit [string range $testname 0 0]] | 910 && [string is digit [string range $testname 0 0]] |
835 } { | 911 } { |
836 set testname "${::testprefix}-$testname" | 912 set testname "${::testprefix}-$testname" |
837 } | 913 } |
838 } | 914 } |
839 | 915 |
840 proc do_execsql_test {testname sql {result {}}} { | 916 proc normalize_list {L} { |
| 917 set L2 [list] |
| 918 foreach l $L {lappend L2 $l} |
| 919 set L2 |
| 920 } |
| 921 |
| 922 # Either: |
| 923 # |
| 924 # do_execsql_test TESTNAME SQL ?RES? |
| 925 # do_execsql_test -db DB TESTNAME SQL ?RES? |
| 926 # |
| 927 proc do_execsql_test {args} { |
| 928 set db db |
| 929 if {[lindex $args 0]=="-db"} { |
| 930 set db [lindex $args 1] |
| 931 set args [lrange $args 2 end] |
| 932 } |
| 933 |
| 934 if {[llength $args]==2} { |
| 935 foreach {testname sql} $args {} |
| 936 set result "" |
| 937 } elseif {[llength $args]==3} { |
| 938 foreach {testname sql result} $args {} |
| 939 } else { |
| 940 error [string trim { |
| 941 wrong # args: should be "do_execsql_test ?-db DB? testname sql ?result?" |
| 942 }] |
| 943 } |
| 944 |
841 fix_testname testname | 945 fix_testname testname |
842 uplevel do_test [list $testname] [list "execsql {$sql}"] [list [list {*}$resul
t]] | 946 |
| 947 uplevel do_test \ |
| 948 [list $testname] \ |
| 949 [list "execsql {$sql} $db"] \ |
| 950 [list [list {*}$result]] |
843 } | 951 } |
| 952 |
844 proc do_catchsql_test {testname sql result} { | 953 proc do_catchsql_test {testname sql result} { |
845 fix_testname testname | 954 fix_testname testname |
846 uplevel do_test [list $testname] [list "catchsql {$sql}"] [list $result] | 955 uplevel do_test [list $testname] [list "catchsql {$sql}"] [list $result] |
847 } | 956 } |
848 proc do_timed_execsql_test {testname sql {result {}}} { | 957 proc do_timed_execsql_test {testname sql {result {}}} { |
849 fix_testname testname | 958 fix_testname testname |
850 uplevel do_test [list $testname] [list "execsql_timed {$sql}"]\ | 959 uplevel do_test [list $testname] [list "execsql_timed {$sql}"]\ |
851 [list [list {*}$result]] | 960 [list [list {*}$result]] |
852 } | 961 } |
853 proc do_eqp_test {name sql res} { | 962 proc do_eqp_test {name sql res} { |
(...skipping 167 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
1021 close $fd | 1130 close $fd |
1022 foreach x $content {set known_error($x) 1} | 1131 foreach x $content {set known_error($x) 1} |
1023 foreach x [set_test_counter fail_list] { | 1132 foreach x [set_test_counter fail_list] { |
1024 if {[info exists known_error($x)]} {incr nKnown} | 1133 if {[info exists known_error($x)]} {incr nKnown} |
1025 } | 1134 } |
1026 } | 1135 } |
1027 if {$nKnown>0} { | 1136 if {$nKnown>0} { |
1028 output2 "[expr {$nErr-$nKnown}] new errors and $nKnown known errors\ | 1137 output2 "[expr {$nErr-$nKnown}] new errors and $nKnown known errors\ |
1029 out of $nTest tests" | 1138 out of $nTest tests" |
1030 } else { | 1139 } else { |
1031 output2 "$nErr errors out of $nTest tests" | 1140 set cpuinfo {} |
| 1141 if {[catch {exec hostname} hname]==0} {set cpuinfo [string trim $hname]} |
| 1142 append cpuinfo " $::tcl_platform(os)" |
| 1143 append cpuinfo " [expr {$::tcl_platform(pointerSize)*8}]-bit" |
| 1144 append cpuinfo " [string map {E -e} $::tcl_platform(byteOrder)]" |
| 1145 output2 "SQLite [sqlite3 -sourceid]" |
| 1146 output2 "$nErr errors out of $nTest tests on $cpuinfo" |
1032 } | 1147 } |
1033 if {$nErr>$nKnown} { | 1148 if {$nErr>$nKnown} { |
1034 output2 -nonewline "!Failures on these tests:" | 1149 output2 -nonewline "!Failures on these tests:" |
1035 foreach x [set_test_counter fail_list] { | 1150 foreach x [set_test_counter fail_list] { |
1036 if {![info exists known_error($x)]} {output2 -nonewline " $x"} | 1151 if {![info exists known_error($x)]} {output2 -nonewline " $x"} |
1037 } | 1152 } |
1038 output2 "" | 1153 output2 "" |
1039 } | 1154 } |
1040 foreach warning [set_test_counter warn_list] { | 1155 foreach warning [set_test_counter warn_list] { |
1041 output2 "Warning: $warning" | 1156 output2 "Warning: $warning" |
(...skipping 153 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
1195 set G "\033\[32;1m" ;# Green fg | 1310 set G "\033\[32;1m" ;# Green fg |
1196 set B "\033\[34;1m" ;# Red fg | 1311 set B "\033\[34;1m" ;# Red fg |
1197 set D "\033\[39;0m" ;# Default fg | 1312 set D "\033\[39;0m" ;# Default fg |
1198 } else { | 1313 } else { |
1199 set R "" | 1314 set R "" |
1200 set G "" | 1315 set G "" |
1201 set B "" | 1316 set B "" |
1202 set D "" | 1317 set D "" |
1203 } | 1318 } |
1204 foreach opcode { | 1319 foreach opcode { |
1205 Seek SeekGe SeekGt SeekLe SeekLt NotFound Last Rewind | 1320 Seek SeekGE SeekGT SeekLE SeekLT NotFound Last Rewind |
1206 NoConflict Next Prev VNext VPrev VFilter | 1321 NoConflict Next Prev VNext VPrev VFilter |
1207 SorterSort SorterNext | 1322 SorterSort SorterNext NextIfOpen |
1208 } { | 1323 } { |
1209 set color($opcode) $B | 1324 set color($opcode) $B |
1210 } | 1325 } |
1211 foreach opcode {ResultRow} { | 1326 foreach opcode {ResultRow} { |
1212 set color($opcode) $G | 1327 set color($opcode) $G |
1213 } | 1328 } |
1214 foreach opcode {IdxInsert Insert Delete IdxDelete} { | 1329 foreach opcode {IdxInsert Insert Delete IdxDelete} { |
1215 set color($opcode) $R | 1330 set color($opcode) $R |
1216 } | 1331 } |
1217 | 1332 |
1218 set bSeenGoto 0 | 1333 set bSeenGoto 0 |
1219 $db eval "explain $sql" {} { | 1334 $db eval "explain $sql" {} { |
1220 set x($addr) 0 | 1335 set x($addr) 0 |
1221 set op($addr) $opcode | 1336 set op($addr) $opcode |
1222 | 1337 |
1223 if {$opcode == "Goto" && ($bSeenGoto==0 || ($p2 > $addr+10))} { | 1338 if {$opcode == "Goto" && ($bSeenGoto==0 || ($p2 > $addr+10))} { |
1224 set linebreak($p2) 1 | 1339 set linebreak($p2) 1 |
1225 set bSeenGoto 1 | 1340 set bSeenGoto 1 |
1226 } | 1341 } |
1227 | 1342 |
| 1343 if {$opcode=="Once"} { |
| 1344 for {set i $addr} {$i<$p2} {incr i} { |
| 1345 set star($i) $addr |
| 1346 } |
| 1347 } |
| 1348 |
1228 if {$opcode=="Next" || $opcode=="Prev" | 1349 if {$opcode=="Next" || $opcode=="Prev" |
1229 || $opcode=="VNext" || $opcode=="VPrev" | 1350 || $opcode=="VNext" || $opcode=="VPrev" |
1230 || $opcode=="SorterNext" | 1351 || $opcode=="SorterNext" || $opcode=="NextIfOpen" |
1231 } { | 1352 } { |
1232 for {set i $p2} {$i<$addr} {incr i} { | 1353 for {set i $p2} {$i<$addr} {incr i} { |
1233 incr x($i) 2 | 1354 incr x($i) 2 |
1234 } | 1355 } |
1235 } | 1356 } |
1236 | 1357 |
1237 if {$opcode == "Goto" && $p2<$addr && $op($p2)=="Yield"} { | 1358 if {$opcode == "Goto" && $p2<$addr && $op($p2)=="Yield"} { |
1238 for {set i [expr $p2+1]} {$i<$addr} {incr i} { | 1359 for {set i [expr $p2+1]} {$i<$addr} {incr i} { |
1239 incr x($i) 2 | 1360 incr x($i) 2 |
1240 } | 1361 } |
1241 } | 1362 } |
1242 | 1363 |
1243 if {$opcode == "Halt" && $comment == "End of coroutine"} { | 1364 if {$opcode == "Halt" && $comment == "End of coroutine"} { |
1244 set linebreak([expr $addr+1]) 1 | 1365 set linebreak([expr $addr+1]) 1 |
1245 } | 1366 } |
1246 } | 1367 } |
1247 | 1368 |
1248 $db eval "explain $sql" {} { | 1369 $db eval "explain $sql" {} { |
1249 if {[info exists linebreak($addr)]} { | 1370 if {[info exists linebreak($addr)]} { |
1250 output2 "" | 1371 output2 "" |
1251 } | 1372 } |
1252 set I [string repeat " " $x($addr)] | 1373 set I [string repeat " " $x($addr)] |
1253 | 1374 |
| 1375 if {[info exists star($addr)]} { |
| 1376 set ii [expr $x($star($addr))] |
| 1377 append I " " |
| 1378 set I [string replace $I $ii $ii *] |
| 1379 } |
| 1380 |
1254 set col "" | 1381 set col "" |
1255 catch { set col $color($opcode) } | 1382 catch { set col $color($opcode) } |
1256 | 1383 |
1257 output2 [format {%-4d %s%s%-12.12s%s %-6d %-6d %-6d % -17s %s %s} \ | 1384 output2 [format {%-4d %s%s%-12.12s%s %-6d %-6d %-6d % -17s %s %s} \ |
1258 $addr $I $col $opcode $D $p1 $p2 $p3 $p4 $p5 $comment | 1385 $addr $I $col $opcode $D $p1 $p2 $p3 $p4 $p5 $comment |
1259 ] | 1386 ] |
1260 } | 1387 } |
1261 output2 "---- ------------ ------ ------ ------ ---------------- -- -" | 1388 output2 "---- ------------ ------ ------ ------ ---------------- -- -" |
1262 } | 1389 } |
1263 | 1390 |
(...skipping 581 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
1845 WHERE type IN('table', 'view') AND name NOT LIKE 'sqliteX_%' ESCAPE 'X' | 1972 WHERE type IN('table', 'view') AND name NOT LIKE 'sqliteX_%' ESCAPE 'X' |
1846 "] { | 1973 "] { |
1847 $db eval "DROP $type \"$t\"" | 1974 $db eval "DROP $type \"$t\"" |
1848 } | 1975 } |
1849 } | 1976 } |
1850 ifcapable trigger&&foreignkey { | 1977 ifcapable trigger&&foreignkey { |
1851 $db eval "PRAGMA foreign_keys = $pk" | 1978 $db eval "PRAGMA foreign_keys = $pk" |
1852 } | 1979 } |
1853 } | 1980 } |
1854 | 1981 |
| 1982 # Drop all auxiliary indexes from the main database opened by handle [db]. |
| 1983 # |
| 1984 proc drop_all_indexes {{db db}} { |
| 1985 set L [$db eval { |
| 1986 SELECT name FROM sqlite_master WHERE type='index' AND sql LIKE 'create%' |
| 1987 }] |
| 1988 foreach idx $L { $db eval "DROP INDEX $idx" } |
| 1989 } |
| 1990 |
| 1991 |
1855 #------------------------------------------------------------------------- | 1992 #------------------------------------------------------------------------- |
1856 # If a test script is executed with global variable $::G(perm:name) set to | 1993 # If a test script is executed with global variable $::G(perm:name) set to |
1857 # "wal", then the tests are run in WAL mode. Otherwise, they should be run | 1994 # "wal", then the tests are run in WAL mode. Otherwise, they should be run |
1858 # in rollback mode. The following Tcl procs are used to make this less | 1995 # in rollback mode. The following Tcl procs are used to make this less |
1859 # intrusive: | 1996 # intrusive: |
1860 # | 1997 # |
1861 # wal_set_journal_mode ?DB? | 1998 # wal_set_journal_mode ?DB? |
1862 # | 1999 # |
1863 # If running a WAL test, execute "PRAGMA journal_mode = wal" using | 2000 # If running a WAL test, execute "PRAGMA journal_mode = wal" using |
1864 # connection handle DB. Otherwise, this command is a no-op. | 2001 # connection handle DB. Otherwise, this command is a no-op. |
(...skipping 16 matching lines...) Expand all Loading... |
1881 $db eval "PRAGMA journal_mode = WAL" | 2018 $db eval "PRAGMA journal_mode = WAL" |
1882 } | 2019 } |
1883 } | 2020 } |
1884 proc wal_check_journal_mode {testname {db db}} { | 2021 proc wal_check_journal_mode {testname {db db}} { |
1885 if { [wal_is_wal_mode] } { | 2022 if { [wal_is_wal_mode] } { |
1886 $db eval { SELECT * FROM sqlite_master } | 2023 $db eval { SELECT * FROM sqlite_master } |
1887 do_test $testname [list $db eval "PRAGMA main.journal_mode"] {wal} | 2024 do_test $testname [list $db eval "PRAGMA main.journal_mode"] {wal} |
1888 } | 2025 } |
1889 } | 2026 } |
1890 | 2027 |
| 2028 proc wal_is_capable {} { |
| 2029 ifcapable !wal { return 0 } |
| 2030 if {[permutation]=="journaltest"} { return 0 } |
| 2031 return 1 |
| 2032 } |
| 2033 |
1891 proc permutation {} { | 2034 proc permutation {} { |
1892 set perm "" | 2035 set perm "" |
1893 catch {set perm $::G(perm:name)} | 2036 catch {set perm $::G(perm:name)} |
1894 set perm | 2037 set perm |
1895 } | 2038 } |
1896 proc presql {} { | 2039 proc presql {} { |
1897 set presql "" | 2040 set presql "" |
1898 catch {set presql $::G(perm:presql)} | 2041 catch {set presql $::G(perm:presql)} |
1899 set presql | 2042 set presql |
1900 } | 2043 } |
1901 | 2044 |
| 2045 proc isquick {} { |
| 2046 set ret 0 |
| 2047 catch {set ret $::G(isquick)} |
| 2048 set ret |
| 2049 } |
| 2050 |
1902 #------------------------------------------------------------------------- | 2051 #------------------------------------------------------------------------- |
1903 # | 2052 # |
1904 proc slave_test_script {script} { | 2053 proc slave_test_script {script} { |
1905 | 2054 |
1906 # Create the interpreter used to run the test script. | 2055 # Create the interpreter used to run the test script. |
1907 interp create tinterp | 2056 interp create tinterp |
1908 | 2057 |
1909 # Populate some global variables that tester.tcl expects to see. | 2058 # Populate some global variables that tester.tcl expects to see. |
1910 foreach {var value} [list \ | 2059 foreach {var value} [list \ |
1911 ::argv0 $::argv0 \ | 2060 ::argv0 $::argv0 \ |
(...skipping 161 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
2073 catch {db3 close} | 2222 catch {db3 close} |
2074 | 2223 |
2075 sqlite3_shutdown | 2224 sqlite3_shutdown |
2076 eval sqlite3_config_pagecache $::old_pagecache_config | 2225 eval sqlite3_config_pagecache $::old_pagecache_config |
2077 unset ::old_pagecache_config | 2226 unset ::old_pagecache_config |
2078 sqlite3_initialize | 2227 sqlite3_initialize |
2079 autoinstall_test_functions | 2228 autoinstall_test_functions |
2080 sqlite3 db test.db | 2229 sqlite3 db test.db |
2081 } | 2230 } |
2082 | 2231 |
| 2232 proc test_find_binary {nm} { |
| 2233 if {$::tcl_platform(platform)=="windows"} { |
| 2234 set ret "$nm.exe" |
| 2235 } else { |
| 2236 set ret $nm |
| 2237 } |
| 2238 set ret [file normalize [file join $::cmdlinearg(TESTFIXTURE_HOME) $ret]] |
| 2239 if {![file executable $ret]} { |
| 2240 finish_test |
| 2241 return "" |
| 2242 } |
| 2243 return $ret |
| 2244 } |
| 2245 |
| 2246 # Find the name of the 'shell' executable (e.g. "sqlite3.exe") to use for |
| 2247 # the tests in shell[1-5].test. If no such executable can be found, invoke |
| 2248 # [finish_test ; return] in the callers context. |
| 2249 # |
| 2250 proc test_find_cli {} { |
| 2251 set prog [test_find_binary sqlite3] |
| 2252 if {$prog==""} { return -code return } |
| 2253 return $prog |
| 2254 } |
| 2255 |
| 2256 # Find the name of the 'sqldiff' executable (e.g. "sqlite3.exe") to use for |
| 2257 # the tests in sqldiff tests. If no such executable can be found, invoke |
| 2258 # [finish_test ; return] in the callers context. |
| 2259 # |
| 2260 proc test_find_sqldiff {} { |
| 2261 set prog [test_find_binary sqldiff] |
| 2262 if {$prog==""} { return -code return } |
| 2263 return $prog |
| 2264 } |
| 2265 |
| 2266 |
2083 # If the library is compiled with the SQLITE_DEFAULT_AUTOVACUUM macro set | 2267 # If the library is compiled with the SQLITE_DEFAULT_AUTOVACUUM macro set |
2084 # to non-zero, then set the global variable $AUTOVACUUM to 1. | 2268 # to non-zero, then set the global variable $AUTOVACUUM to 1. |
2085 set AUTOVACUUM $sqlite_options(default_autovacuum) | 2269 set AUTOVACUUM $sqlite_options(default_autovacuum) |
2086 | 2270 |
2087 # Make sure the FTS enhanced query syntax is disabled. | 2271 # Make sure the FTS enhanced query syntax is disabled. |
2088 set sqlite_fts3_enable_parentheses 0 | 2272 set sqlite_fts3_enable_parentheses 0 |
2089 | 2273 |
2090 # During testing, assume that all database files are well-formed. The | 2274 # During testing, assume that all database files are well-formed. The |
2091 # few test cases that deliberately corrupt database files should rescind | 2275 # few test cases that deliberately corrupt database files should rescind |
2092 # this setting by invoking "database_can_be_corrupt" | 2276 # this setting by invoking "database_can_be_corrupt" |
2093 # | 2277 # |
2094 database_never_corrupt | 2278 database_never_corrupt |
2095 | 2279 |
2096 source $testdir/thread_common.tcl | 2280 source $testdir/thread_common.tcl |
2097 source $testdir/malloc_common.tcl | 2281 source $testdir/malloc_common.tcl |
OLD | NEW |