Index: src/main.mk ================================================================== --- src/main.mk +++ src/main.mk @@ -459,15 +459,25 @@ $(BCC) -o $(OBJDIR)/mkversion $(SRCDIR)/mkversion.c $(OBJDIR)/codecheck1: $(SRCDIR)/codecheck1.c $(BCC) -o $(OBJDIR)/codecheck1 $(SRCDIR)/codecheck1.c -# WARNING. DANGER. Running the test suite modifies the repository the -# build is done from, i.e. the checkout belongs to. Do not sync/push -# the repository after running the tests. +# Run the test suite. +# Other flags that can be included in TESTFLAGS are: +# +# -halt Stop testing after the first failed test +# -keep Keep the temporary workspace for debugging +# -prot Write a detailed log of the tests to the file ./prot +# -verbose Include even more details in the output +# -quiet Hide most output from the terminal +# -strict Treat known bugs as failures +# +# TESTFLAGS can also include names of specific test files to limit +# the run to just those test cases. +# test: $(OBJDIR) $(APPNAME) - $(TCLSH) $(SRCDIR)/../test/tester.tcl $(APPNAME) + $(TCLSH) $(SRCDIR)/../test/tester.tcl $(APPNAME) -quiet $(TESTFLAGS) $(OBJDIR)/VERSION.h: $(SRCDIR)/../manifest.uuid $(SRCDIR)/../manifest $(SRCDIR)/../VERSION $(OBJDIR)/mkversion $(OBJDIR)/mkversion $(SRCDIR)/../manifest.uuid $(SRCDIR)/../manifest $(SRCDIR)/../VERSION >$(OBJDIR)/VERSION.h # Setup the options used to compile the included SQLite library. Index: src/makemake.tcl ================================================================== --- src/makemake.tcl +++ src/makemake.tcl @@ -303,15 +303,25 @@ $(BCC) -o $(OBJDIR)/mkversion $(SRCDIR)/mkversion.c $(OBJDIR)/codecheck1: $(SRCDIR)/codecheck1.c $(BCC) -o $(OBJDIR)/codecheck1 $(SRCDIR)/codecheck1.c -# WARNING. DANGER. Running the test suite modifies the repository the -# build is done from, i.e. the checkout belongs to. Do not sync/push -# the repository after running the tests. +# Run the test suite. +# Other flags that can be included in TESTFLAGS are: +# +# -halt Stop testing after the first failed test +# -keep Keep the temporary workspace for debugging +# -prot Write a detailed log of the tests to the file ./prot +# -verbose Include even more details in the output +# -quiet Hide most output from the terminal +# -strict Treat known bugs as failures +# +# TESTFLAGS can also include names of specific test files to limit +# the run to just those test cases. +# test: $(OBJDIR) $(APPNAME) - $(TCLSH) $(SRCDIR)/../test/tester.tcl $(APPNAME) + $(TCLSH) $(SRCDIR)/../test/tester.tcl $(APPNAME) -quiet $(TESTFLAGS) $(OBJDIR)/VERSION.h: $(SRCDIR)/../manifest.uuid $(SRCDIR)/../manifest $(SRCDIR)/../VERSION $(OBJDIR)/mkversion $(OBJDIR)/mkversion $(SRCDIR)/../manifest.uuid \ $(SRCDIR)/../manifest \ $(SRCDIR)/../VERSION >$(OBJDIR)/VERSION.h Index: test/amend.test ================================================================== --- test/amend.test +++ test/amend.test @@ -47,26 +47,26 @@ fossil status regexp {checkout:\s+([0-9a-f]{40})} $RESULT m UUID } # Make sure we are not in an open repository and initialize new repository -repo_init +test_setup ######################################## # Setup: Add file and commit # ######################################## if {![uuid_from_checkout UUIDINIT]} { test amend-checkout-failure false - return + test_cleanup_then_return } write_file datafile "data" fossil add datafile fossil commit -m "c1" if {![uuid_from_commit $RESULT UUID]} { test amend-setup-failure false - return + test_cleanup_then_return } ######################################## # Test: -branch # ######################################## @@ -401,5 +401,9 @@ ######################################## # Test: NULL UUID # ######################################## fossil amend {} -close -expectError test amend-null-uuid {$CODE && [string first "no such check-in" $RESULT] != -1} + +############################################################################### + +test_cleanup Index: test/clean.test ================================================================== --- test/clean.test +++ test/clean.test @@ -16,11 +16,11 @@ ############################################################################ # # Tests of the "clean" command, including the ability to undo it. # -repo_init +test_setup ############################################################################### fossil extra test clean-0 {[normalize_result] eq {}} @@ -185,5 +185,9 @@ ############################################################################### fossil extra test clean-31 {[normalize_result] eq {}} + +############################################################################### + +test_cleanup Index: test/cmdline.test ================================================================== --- test/cmdline.test +++ test/cmdline.test @@ -15,10 +15,12 @@ # ############################################################################ # # Test command line parsing # + +test_setup "" proc cmd-line {testname args} { set i 1 foreach {cmdline result} $args { fossil test-echo $cmdline @@ -26,5 +28,9 @@ incr i } } cmd-line 100 abc abc a\"bc a\"bc \"abc\" \"abc\" cmd-line 101 * * *.* *.* + +############################################################################### + +test_cleanup Index: test/comment.test ================================================================== --- test/comment.test +++ test/comment.test @@ -16,10 +16,14 @@ ############################################################################ # # Test comment formatting and printing. # +test_setup "" + +############################################################################### + fossil test-comment-format "" "" test comment-1 {$RESULT eq "\n(1 lines output)"} ############################################################################### @@ -314,5 +318,9 @@ ############################################################################### fossil test-comment-format --width 81 --indent 9 --decode --trimcrlf --origbreak "00:00:00 " "\[0000000000\] *CURRENT* $orig" $orig test comment-60 {$RESULT eq "00:00:00 \[0000000000\] *CURRENT* \n xxxx xx xxxxxxx xxxx xxxxxx xxxxxxx, xxxxxxx, x xxxx xxxxxx xx xxxx xxxx\n xxxxxxx xxxxx xxxx xxxx xx xxxxxxx xxxxxxx (xxxxxx xxxxxxxxx x xxxxx).\n xxx'x xxx xxx xx xxxxx xxxx xxx xxx --xxxxxxxxxxx xxxxxx xx xx xxxx. x\n xxxxx x xxxxxx xxxx xxxx xxxx xxxx xxxx x xxxxx xx xxx x xxxxxxxx\n xxxxxxx.\n(6 lines output)"} + +############################################################################### + +test_cleanup Index: test/contains-selector.test ================================================================== --- test/contains-selector.test +++ test/contains-selector.test @@ -15,10 +15,12 @@ # ############################################################################ # # Test containsSelector() function in src/style.c # + +test_setup "" proc contains-selector {testId css selectorResultMap} { set css [string trim $css] set filename [file join $::tempPath compare-selector.css] set fh [open $filename w] @@ -45,5 +47,9 @@ .d 0 {.c.d} 0 {.c .d} 1 .e 1 } + +############################################################################### + +test_cleanup Index: test/delta1.test ================================================================== --- test/delta1.test +++ test/delta1.test @@ -15,10 +15,12 @@ # ############################################################################ # # Tests of the delta mechanism. # + +test_setup "" # Use test script files as the basis for this test. # # For each test, copy the file intact to "./t1". Make # some random changes in "./t2". Then call test-delta on the @@ -41,5 +43,9 @@ write_file t2 [random_changes $f1 1 1 0 0.4] fossil test-delta t1 t2 test delta-$base-$i-3 {$RESULT=="ok"} } } + +############################################################################### + +test_cleanup Index: test/file1.test ================================================================== --- test/file1.test +++ test/file1.test @@ -16,11 +16,11 @@ ############################################################################ # # File utilities # -repo_init +test_setup proc simplify-name {testname args} { set i 1 foreach {path result} $args { fossil test-simplify-name $path @@ -96,5 +96,9 @@ catch {file delete test1/test2} catch {file delete test1} if {[info exists savedPwd]} {cd $savedPwd; unset savedPwd} + +############################################################################### + +test_cleanup Index: test/glob.test ================================================================== --- test/glob.test +++ test/glob.test @@ -15,10 +15,12 @@ # ############################################################################ # # Test glob pattern parsing # + +test_setup "" proc glob-parse {testname args} { set i 1 foreach {pattern string result} $args { fossil test-glob $pattern $string @@ -180,5 +182,9 @@ glob-parse 119 "'o*,two three,four'" "one,two three,four" \ [string map [list \r\n \n] \ {SQL expression: (x GLOB 'o*,two three,four') pattern[0] = [o*,two three,four] 1 one,two three,four}] + +############################################################################### + +test_cleanup Index: test/json.test ================================================================== --- test/json.test +++ test/json.test @@ -24,11 +24,12 @@ # not configured. If that changes, these conditions might not prevent # the rest of this file from running. fossil test-th-eval "hasfeature json" if {$::RESULT ne "1"} then { - puts "Fossil was not compiled with JSON support."; return + puts "Fossil was not compiled with JSON support." + test_cleanup_then_return } # We need a JSON parser to effectively test the JSON produced by # fossil. It looks like the one from tcllib is exactly what we need. # On ActiveTcl, add it with teacup. On other platforms, YMMV. @@ -47,11 +48,12 @@ # and that the json itself smells ok and has the expected API error code in it fossil json -expectError set JR [json2dict $RESULT] if {$JR eq ""} { - puts "Fossil was not compiled with JSON support (bad JSON)."; return + puts "Fossil was not compiled with JSON support (bad JSON)." + test_cleanup_then_return } test json-1 {[dict exists $JR resultCode] && [dict get $JR resultCode] eq "FOSSIL-4102"} # Use the CLI interface to execute a JSON command. Sets the global @@ -163,11 +165,11 @@ } #### VERSION AKA HAI # The JSON API generally assumes we have a respository, so let it have one. -repo_init +test_setup # Check for basic envelope fields in the result with an error fossil_json -expectError test_json_envelope json-enverr [concat resultCode fossil timestamp \ resultText command procTimeUs procTimeMs] {} @@ -666,11 +668,11 @@ # is not writable" error comes back as HTML. i don't know if the # error happens before we have made the determination that the app is # in JSON mode or if the error handling is incorrectly not # recognizing JSON mode. # -#repo_init x.fossil +#test_setup x.fossil #catch {exec chmod 444 .rep.fossil}; # Unix. What about Win? fossil_http_json /json/timeline/checkin $U1Cookie test json-ROrepo-1-1 {$CODE == 0} test json-ROrepo-1-2 {[regexp {\}\s*$} $RESULT]} test json-ROrepo-1-3 {![regexp {SQLITE_[A-Z]+:} $RESULT]} @@ -845,5 +847,9 @@ # Fossil repository db file is not valid. write_file nope.fossil { This is not a fossil repo. It ought to be a SQLite db with a well-known schema, but it is actually just a block of text. } + +############################################################################### + +test_cleanup Index: test/merge1.test ================================================================== --- test/merge1.test +++ test/merge1.test @@ -15,10 +15,12 @@ # ############################################################################ # # Tests of the 3-way merge # + +test_setup "" write_file_indented t1 { 111 - This is line one of the demo program - 1111 222 - The second line program line in code - 2222 333 - This is a test of the merging algohm - 3333 @@ -398,5 +400,9 @@ STUV XYZ. } fossil 3-way-merge t1 t2 t3 a23 test merge1-7.2 {[same_file t23 a23]} + +############################################################################### + +test_cleanup Index: test/merge2.test ================================================================== --- test/merge2.test +++ test/merge2.test @@ -15,10 +15,12 @@ # ############################################################################ # # Tests of the delta mechanism. # + +test_setup "" set filelist [glob $testdir/*] foreach f $filelist { if {[file isdir $f]} continue set base [file root [file tail $f]] @@ -38,5 +40,9 @@ test merge-$base-$i-23 {[same_file a23 t23]} fossil 3-way-merge t1 t3 t2 a32 test merge-$base-$i-32 {[same_file a32 t32]} } } + +############################################################################### + +test_cleanup Index: test/merge3.test ================================================================== --- test/merge3.test +++ test/merge3.test @@ -15,10 +15,12 @@ # ############################################################################ # # Tests of the 3-way merge # + +test_setup "" proc merge-test {testid basis v1 v2 result} { write_file t1 [join [string trim $basis] \n]\n write_file t2 [join [string trim $v1] \n]\n write_file t3 [join [string trim $v2] \n]\n @@ -633,5 +635,9 @@ } { 1 2 3 4 5 7 8 9b } { 1 2 3 4 5 7 8 MINE: 9b a b c d e COM: 9 YOURS: 9b END } + +############################################################################### + +test_cleanup Index: test/merge4.test ================================================================== --- test/merge4.test +++ test/merge4.test @@ -15,10 +15,12 @@ # ############################################################################ # # Tests of the 3-way merge # + +test_setup "" proc merge-test {testid basis v1 v2 result1 result2} { write_file t1 [join [string trim $basis] \n]\n write_file t2 [join [string trim $v1] \n]\n write_file t3 [join [string trim $v2] \n]\n @@ -93,5 +95,9 @@ } { 2b 3b 4c 5c 6c 7b 8b } { 2b 3b 4c 5c 6c 7b 8b } + +############################################################################### + +test_cleanup Index: test/merge5.test ================================================================== --- test/merge5.test +++ test/merge5.test @@ -36,19 +36,11 @@ } else { test merge5-$testid 1 } } -catch {exec $::fossilexe info} res -if {![regexp {use --repository} $res]} { - puts stderr "Cannot run this test within an open checkout" - return -} -# -# Fossil will write data on $HOME, running 'fossil open' here. -# We need not to clutter the $HOME of the test caller. -set env(HOME) [pwd] +require_no_open_checkout; test_setup "" # Construct a test repository # exec $::fossilexe sqlite3 --no-repository m5.fossil <$testdir/${testfile}_repo.sql fossil rebuild m5.fossil @@ -309,5 +301,9 @@ checkout-test 142 { 7eaf64a2c9141277b4c24259c7766d6a77047af7 one.txt 98e47f99bb9fed4fdcd407f553615ca7f15a38a2 three.txt e58c5da3e6007d0e30600ea31611813093ad180f two-rename.txt } + +############################################################################### + +test_cleanup Index: test/merge6.test ================================================================== --- test/merge6.test +++ test/merge6.test @@ -20,11 +20,11 @@ #################################################################### # TEST 1: Handle multiple merges each with one or more ADDED files # #################################################################### -repo_init +test_setup fossil ls test merge_multi-0 {[normalize_result] eq {}} write_file f1 "f1 line" @@ -63,5 +63,9 @@ test merge_multi-4 {[normalize_result] eq {f1 f2 f3 f4}} knownBug + +############################################################################### + +test_cleanup Index: test/merge_renames.test ================================================================== --- test/merge_renames.test +++ test/merge_renames.test @@ -1,22 +1,18 @@ # # Tests for merging with renames # # -catch {exec $::fossilexe info} res -if {![regexp {use --repository} $res]} { - puts stderr "Cannot run this test within an open checkout" - return -} +require_no_open_checkout ###################################### # Test 1 # # Reported: Ticket [554f44ee74e3d] # ###################################### -repo_init +test_setup write_file f1 "line" fossil add f1 fossil commit -m "c1" fossil tag add pivot current @@ -70,11 +66,11 @@ ###################################### # Test 2 # # Reported: Ticket [74413366fe5067] # ###################################### -repo_init +test_setup write_file f1 "line" fossil add f1 fossil commit -m "base file" fossil tag add pivot current @@ -118,11 +114,11 @@ ###################################### # Test 3 # # Reported: Ticket [30b28cf351] # ###################################### -repo_init +test_setup write_file f1 "line" fossil add f1 fossil commit -m "base file" fossil tag add pivot current @@ -173,11 +169,11 @@ ###################################### # Test 5 # # Handle Rename/Add via Merge # ###################################### -repo_init +test_setup write_file f1 "old f1 line" fossil add f1 fossil commit -m "base file" @@ -207,5 +203,9 @@ # Tests for troubles not specifically linked with renames but that I'd like to # write: # [c26c63eb1b] - 'merge --backout' does not handle conflicts properly # [953031915f] - Lack of warning when overwriting extra files # [4df5f38f1e] - Troubles merging a file delete with a file change + +############################################################################### + +test_cleanup Index: test/mv-rm.test ================================================================== --- test/mv-rm.test +++ test/mv-rm.test @@ -16,28 +16,22 @@ ############################################################################ # # MV / RM Commands # -catch {exec $::fossilexe info} res -if {![regexp {use --repository} $res]} { - puts stderr "Cannot run this test within an open checkout" - return -} +require_no_open_checkout ######################################## # Setup: Add Files and Commit # ######################################## -set rootDir [file normalize [pwd]] +test_setup; set rootDir [file normalize [pwd]] set undoMsg "\n \"fossil undo\" is\ available to undo changes to the\ working checkout." -repo_init - write_file f1 "f1" write_file f2 "f2" write_file f3 "f3" write_file f4 "f4" write_file f5 "f5" @@ -387,5 +381,9 @@ test rm-hard-absolute-6 { [normalize_result] eq "REVERT f8${undoMsg}" } cd $rootDir + +############################################################################### + +test_cleanup Index: test/revert.test ================================================================== --- test/revert.test +++ test/revert.test @@ -54,17 +54,12 @@ } fossil undo } -catch {exec $::fossilexe info} res -if {![regexp {use --repository} $res]} { - puts stderr "Cannot run this test within an open checkout" - return -} - -repo_init +require_no_open_checkout +test_setup # Prepare first commit # write_file f1 "f1" write_file f2 "f2" @@ -162,11 +157,11 @@ # Test reverting the combination of a renamed file and an added file that # uses the renamed file's original filename. # -repo_init +test_setup write_file f1 "f1" fossil add f1 fossil commit -m "add f1" write_file f1n "f1n" @@ -180,11 +175,11 @@ } -exists {f1} -notexists {f1n} # Test reverting a rename in the repo but not completed in the file # system -repo_init +test_setup write_file f1 "f1" fossil add f1 fossil commit -m "add f1" fossil mv --soft f1 f1new test 3-mv-1 {[file exists f1]} @@ -191,5 +186,9 @@ test 3-mv-2 {![file exists f1new]} revert-test 3-1 {} { REVERT f1 DELETE f1new } -exists {f1} -notexists {f1n} + +############################################################################### + +test_cleanup Index: test/stash.test ================================================================== --- test/stash.test +++ test/stash.test @@ -90,17 +90,12 @@ proc stash-test {testid stashArgs expectedStashOutput args} { fossil stash {*}$stashArgs return [test_result_state stash-$testid "stash $stashArgs" $expectedStashOutput {*}$args] } -catch {exec $::fossilexe info} res -if {![regexp {use --repository} $res]} { - puts stderr "Cannot run this test within an open checkout" - return -} - -repo_init +require_no_open_checkout +test_setup # Prepare first commit # write_file f1 "f1" write_file f2 "f2" @@ -231,11 +226,11 @@ # uses the renamed file's original filename. I expect to see the same # behavior as fossil revert: calmly back out both the rename and the # add, and presumably stash the content of the added file before it # is replaced by the revert. # -repo_init +test_setup write_file f1 "f1" fossil add f1 fossil commit -m "add f1" write_file f1n "f1n" @@ -254,11 +249,11 @@ # Test stashing a newly added (but never committed) file. As with # fossil revert, fossil stash save unmanages the new file, but # leaves the copy present on disk. This is undocumented, but # probably sensible. -repo_init +test_setup write_file f1 "f1" write_file f2 "f2" fossil add f1 f2 fossil commit -m "baseline" @@ -288,21 +283,21 @@ # Test stashing a rename of one file with at least one file # unchanged. This should stash (and revert) just the rename # operation. Instead it also stores and touches the unchanged file. -repo_init +test_setup write_file f1 "f1" write_file f2 "f2" fossil add f1 f2 fossil commit -m "baseline" fossil mv --hard f2 f2n -test_result_state stash-3-4-mv "mv --hard f2 f2n" { +test_result_state stash-3-2-mv "mv --hard f2 f2n" [concat { RENAME f2 f2n - MOVED_FILE f2 -} -changes { + MOVED_FILE} [file normalize f2] { +}] -changes { RENAMED f2n } -addremove { } -exists {f1 f2n} -notexists {f2} stash-test 3-2 {save -m f2n} { @@ -325,11 +320,11 @@ ######## # fossil stash snapshot ?-m|--comment COMMENT? ?FILES...? -repo_init +test_setup write_file f1 "f1" write_file f2 "f2" write_file f3 "f3" fossil add f1 f2 f3 fossil commit -m "c1" --tag c1 @@ -362,11 +357,11 @@ DELETED f1 EDITED f2 } -addremove { } -exists {f0 f2 f3} -notexists {f1} fossil stash diff -test stash-4-2-diff-CODE {!$::CODE} ;# knownBug +test stash-4-2-diff-CODE {!$::CODE} knownBug fossil stash show test stash-4-2-show-1 {[regexp {DELETE f1} $RESULT]} test stash-4-2-show-2 {[regexp {CHANGED f2} $RESULT]} test stash-4-2-show-3 {[regexp {ADDED f0} $RESULT]} @@ -381,11 +376,11 @@ EDITED f2 RENAMED f3n } -addremove { } -exists {f0 f2 f3n} -notexists {f1 f3} fossil stash diff -test stash-4-3-diff-CODE {!$::CODE} ;# knownBug +test stash-4-3-diff-CODE {!$::CODE} knownBug fossil stash show test stash-4-3-show-1 {[regexp {DELETE f1} $RESULT]} test stash-4-3-show-2 {[regexp {CHANGED f2} $RESULT]} test stash-4-3-show-2 {[regexp {CHANGED f3n} $RESULT]} test stash-4-3-show-3 {[regexp {ADDED f0} $RESULT]} @@ -394,5 +389,9 @@ # fossil stash goto ?STASHID? # fossil stash rm|drop ?STASHID? ?-a|--all? #fossil checkout --force c1 #fossil clean + +############################################################################### + +test_cleanup Index: test/tester.tcl ================================================================== --- test/tester.tcl +++ test/tester.tcl @@ -32,10 +32,18 @@ [string length [file extension $fossilexe]] == 0} { append fossilexe .exe } set argv [lrange $argv 1 end] + +set i [lsearch $argv -keep] +if {$i>=0} { + set KEEP 1 + set argv [lreplace $argv $i $i] +} else { + set KEEP 0 +} set i [lsearch $argv -halt] if {$i>=0} { set HALT 1 set argv [lreplace $argv $i $i] @@ -189,30 +197,134 @@ set y [read_file $b] regsub -all { +\n} $y \n y return [expr {$x==$y}] } +proc require_no_open_checkout {} { + if {[info exists ::env(FOSSIL_TEST_DANGEROUS_IGNORE_OPEN_CHECKOUT)] && \ + $::env(FOSSIL_TEST_DANGEROUS_IGNORE_OPEN_CHECKOUT) eq "YES_DO_IT"} { + return + } + catch {exec $::fossilexe info} res + if {![regexp {use --repository} $res]} { + set projectName + set localRoot + regexp -line -- {^project-name: (.*)$} $res dummy projectName + set projectName [string trim $projectName] + regexp -line -- {^local-root: (.*)$} $res dummy localRoot + set localRoot [string trim $localRoot] + error "Detected an open checkout of project \"$projectName\",\ +rooted at \"$localRoot\", testing halted." + } +} + +proc get_script_or_fail {} { + set fileName [file normalize [info script]] + if {[string length $fileName] == 0 || ![file exists $fileName]} { + error "Failed to obtain the file name of the test being run." + } + return $fileName +} + +proc robust_delete { path {force ""} } { + set error "unknown error" + for {set try 0} {$try < 10} {incr try} { + if {$force eq "YES_DO_IT"} { + if {[catch {file delete -force $path} error] == 0} { + return + } + } else { + if {[catch {file delete $path} error] == 0} { + return + } + } + after [expr {$try * 100}] + } + error "Could not delete \"$path\", error: $error" +} + +proc test_cleanup_then_return {} { + uplevel 1 [list test_cleanup] + return -code return +} + +proc test_cleanup {} { + if {$::KEEP} {return}; # All cleanup disabled? + if {![info exists ::tempRepoPath]} {return} + if {![file exists $::tempRepoPath]} {return} + if {![file isdirectory $::tempRepoPath]} {return} + set tempPathEnd [expr {[string length $::tempPath] - 1}] + if {[string length $::tempPath] == 0 || \ + [string range $::tempRepoPath 0 $tempPathEnd] ne $::tempPath} { + error "Temporary repository path has wrong parent during cleanup." + } + if {[info exists ::tempSavedPwd]} {cd $::tempSavedPwd; unset ::tempSavedPwd} + # First, attempt to delete the specific temporary repository directories + # for this test file. + set scriptName [file tail [get_script_or_fail]] + foreach repoSeed $::tempRepoSeeds { + set repoPath [file join $::tempRepoPath $repoSeed $scriptName] + robust_delete $repoPath YES_DO_IT; # FORCE, arbitrary children. + set seedPath [file join $::tempRepoPath $repoSeed] + robust_delete $seedPath; # NO FORCE. + } + # Next, attempt to gracefully delete the temporary repository directory + # for this process. + robust_delete $::tempRepoPath + # Finally, attempt to gracefully delete the temporary home directory, + # unless forbidden by external forces. + if {![info exists ::tempKeepHome]} {delete_temporary_home} +} + +proc delete_temporary_home {} { + if {$::KEEP} {return}; # All cleanup disabled? + if {$::tcl_platform(platform) eq "windows"} { + robust_delete [file join $::tempHomePath _fossil] + } else { + robust_delete [file join $::tempHomePath .fossil] + } + robust_delete $::tempHomePath +} + +proc is_home_elsewhere {} { + return [expr {[info exists ::env(FOSSIL_HOME)] && \ + $::env(FOSSIL_HOME) eq $::tempHomePath}] +} + +proc set_home_to_elsewhere {} { + # + # Fossil will write data on $HOME (or $FOSSIL_HOME). We need not + # to clutter the real $HOME (or $FOSSIL_HOME) of the test caller. + # + if {[is_home_elsewhere]} {return} + set ::env(FOSSIL_HOME) $::tempHomePath +} + +# # Create and open a new Fossil repository and clean the checkout # -proc repo_init {{filename ".rep.fossil"}} { - if {$::env(HOME) ne [pwd]} { - catch {exec $::fossilexe info} res - if {![regexp {use --repository} $res]} { - error "In an open checkout: cannot initialize a new repository here." - } - # Fossil will write data on $FOSSIL_HOME, running 'fossil new' here. - # We need not to clutter the $HOME of the test caller. - # - set ::env(FOSSIL_HOME) [pwd] - set ::env(HOME) [pwd] - } - catch {exec $::fossilexe close -f} - file delete $filename - exec $::fossilexe new $filename - exec $::fossilexe open $filename - exec $::fossilexe clean -f - exec $::fossilexe set mtime-changes off +proc test_setup {{filename ".rep.fossil"}} { + set_home_to_elsewhere + if {![info exists ::tempRepoPath]} { + set ::tempRepoPath [file join $::tempPath repo_[pid]] + } + set repoSeed [appendArgs [string trim [clock seconds] -] _ [getSeqNo]] + lappend ::tempRepoSeeds $repoSeed + set repoPath [file join \ + $::tempRepoPath $repoSeed [file tail [get_script_or_fail]]] + if {[catch { + file mkdir $repoPath + } error] != 0} { + error "Could not make directory \"$repoPath\",\ +please set TEMP variable in environment, error: $error" + } + if {![info exists ::tempSavedPwd]} {set ::tempSavedPwd [pwd]}; cd $repoPath + if {[string length $filename] > 0} { + exec $::fossilexe new $filename + exec $::fossilexe open $filename + exec $::fossilexe set mtime-changes off + } } # This procedure only returns non-zero if the Tcl integration feature was # enabled at compile-time and is now enabled at runtime. proc is_tcl_usable_by_fossil {} { @@ -284,10 +396,67 @@ # Append all arguments into a single value and then returns it. # proc appendArgs {args} { eval append result $args } + +# Returns the value of the specified environment variable -OR- any empty +# string if it does not exist. +# +proc getEnvironmentVariable { name } { + return [expr {[info exists ::env($name)] ? $::env($name) : ""}] +} + +# Returns a usable temporary directory -OR- fails the testing process. +# +proc getTemporaryPath {} { + # + # NOTE: Build the list of "temporary directory" environment variables + # to check, including all reasonable "cases" of the environment + # variable names. + # + set names [list] + + # + # TODO: Add more here, if necessary. + # + foreach name [list FOSSIL_TEST_TEMP FOSSIL_TEMP TEMP TMP] { + lappend names [string toupper $name] [string tolower $name] \ + [string totitle $name] + } + + # + # NOTE: Check if we can use any of the environment variables. + # + foreach name $names { + set value [getEnvironmentVariable $name] + + if {[string length $value] > 0} then { + set value [file normalize $value] + + if {[file exists $value] && [file isdirectory $value]} then { + return $value + } + } + } + + # + # NOTE: On non-Windows systems, fallback to /tmp if it is usable. + # + if {$::tcl_platform(platform) ne "windows"} { + set value /tmp + + if {[file exists $value] && [file isdirectory $value]} then { + return $value + } + } + + # + # NOTE: There must be a usable temporary directory to continue testing. + # + error "Cannot find a usable temporary directory, testing halted." +} # Return the name of the versioned settings file containing the TH1 # setup script. # proc getTh1SetupFileName {} { @@ -498,38 +667,41 @@ # returns the third to last line of the normalized result. proc third_to_last_data_line {} { return [lindex [split [normalize_result] \n] end-2] } -set tempPath [expr {[info exists env(TEMP)] ? \ - $env(TEMP) : [file dirname [info script]]}] +set tempPath [getTemporaryPath] if {$tcl_platform(platform) eq "windows"} { set tempPath [string map [list \\ /] $tempPath] } -set tempPath [file normalize $tempPath] +if {[catch { + set tempFile [file join $tempPath temporary.txt] + write_file $tempFile [clock seconds]; file delete $tempFile +} error] != 0} { + error "Could not write file \"$tempFile\" in directory \"$tempPath\",\ +please set TEMP variable in environment, error: $error" +} + +set tempHomePath [file join $tempPath home_[pid]] if {[catch { - write_file [file join $tempPath temporary.txt] [clock seconds] + file mkdir $tempHomePath } error] != 0} { - error "could not write file to directory \"$tempPath\",\ -please set TEMP variable in environment: $error" + error "Could not make directory \"$tempHomePath\",\ +please set TEMP variable in environment, error: $error" } protInit $fossilexe +set ::tempKeepHome 1 foreach testfile $argv { - set dir [file root [file tail $testfile]] - file delete -force $dir - file mkdir $dir - set origwd [pwd] - cd $dir protOut "***** $testfile ******" source $testdir/$testfile.test protOut "***** End of $testfile: [llength $bad_test] errors so far ******" - cd $origwd } +unset ::tempKeepHome; delete_temporary_home set nErr [llength $bad_test] if {$nErr>0 || !$::QUIET} { protOut "***** Final results: $nErr errors out of $test_count tests" 1 } if {$nErr>0} { Index: test/th1-docs.test ================================================================== --- test/th1-docs.test +++ test/th1-docs.test @@ -18,19 +18,25 @@ # TH1 Docs # fossil test-th-eval "hasfeature th1Docs" -if {$::RESULT ne "1"} then { - puts "Fossil was not compiled with TH1 docs support."; return +if {$::RESULT ne "1"} { + puts "Fossil was not compiled with TH1 docs support." + test_cleanup_then_return } fossil test-th-eval "hasfeature tcl" -if {$::RESULT ne "1"} then { - puts "Fossil was not compiled with Tcl support."; return +if {$::RESULT ne "1"} { + puts "Fossil was not compiled with Tcl support." + test_cleanup_then_return } + +############################################################################### + +test_setup "" ############################################################################### set env(TH1_ENABLE_DOCS) 1; # TH1 docs must be enabled for this test. set env(TH1_ENABLE_TCL) 1; # Tcl integration must be enabled for this test. @@ -41,11 +47,11 @@ set data [fossil info] } regexp -line -- {^repository: (.*)$} $data dummy repository -if {[string length $repository] == 0 || ![file exists $repository]} then { +if {[string length $repository] == 0 || ![file exists $repository]} { error "unable to locate repository" } set dataFileName [file join $::testdir th1-docs-input.txt] @@ -57,5 +63,9 @@ } test th1-docs-1a {[regexp {Fossil: test/fileStat.th1} $RESULT]} test th1-docs-1b {[regexp {>\[[0-9a-f]{40}\]<} $RESULT]} test th1-docs-1c {[regexp { contains \d+ files\.} $RESULT]} + +############################################################################### + +test_cleanup Index: test/th1-hooks.test ================================================================== --- test/th1-hooks.test +++ test/th1-hooks.test @@ -18,17 +18,21 @@ # TH1 Hooks # fossil test-th-eval "hasfeature th1Hooks" -if {$::RESULT ne "1"} then { - puts "Fossil was not compiled with TH1 hooks support."; return +if {$::RESULT ne "1"} { + puts "Fossil was not compiled with TH1 hooks support." + test_cleanup_then_return } ############################################################################### -repo_init +test_setup + +############################################################################### + write_file f1 "f1"; fossil add f1; fossil commit -m "c1" ############################################################################### set env(TH1_ENABLE_HOOKS) 1; # TH1 hooks must be enabled for this test. @@ -106,11 +110,11 @@ ############################################################################### set data [fossil info] regexp -line -- {^repository: (.*)$} $data dummy repository -if {[string length $repository] == 0 || ![file exists $repository]} then { +if {[string length $repository] == 0 || ![file exists $repository]} { error "unable to locate repository" } set dataFileName [file join $::testdir th1-hooks-input.txt] @@ -195,5 +199,9 @@ {

command_hook http webpage_hook test1 webpage_notify test1

}} ############################################################################### restoreTh1SetupFile + +############################################################################### + +test_cleanup Index: test/th1-repo.test ================================================================== --- test/th1-repo.test +++ test/th1-repo.test @@ -19,23 +19,17 @@ ############################################################################ # # TH1 tests that may modify the repository # -catch {exec $::fossilexe info} res -if {![regexp {use --repository} $res]} { - puts stderr "Cannot run this test within an open checkout" - return -} +require_no_open_checkout ######################################## # Setup: Add Files and Commit # ######################################## -set rootDir [file normalize [pwd]] - -repo_init +test_setup; set rootDir [file normalize [pwd]] write_file f1.md "f1" write_file f2.md "f2" write_file f3.txt "f3" write_file f4.md "f4" @@ -86,5 +80,9 @@ test th1-dir-3.8 {[lindex [lindex $RESULT 2] 1] == 2} test th1-dir-3.9 {[regexp -- $dateTime [lindex [lindex $RESULT 2] 2]]} test th1-dir-3.10 {[lindex [lindex $RESULT 3] 0] eq "subdirC/f10.md"} test th1-dir-3.11 {[lindex [lindex $RESULT 3] 1] == 3} test th1-dir-3.12 {[regexp -- $dateTime [lindex [lindex $RESULT 3] 2]]} + +############################################################################### + +test_cleanup Index: test/th1-tcl.test ================================================================== --- test/th1-tcl.test +++ test/th1-tcl.test @@ -20,19 +20,20 @@ set dir [file dirname [info script]] ############################################################################### -repo_init - -############################################################################### - fossil test-th-eval "hasfeature tcl" -if {$::RESULT ne "1"} then { - puts "Fossil was not compiled with Tcl support."; return +if {$::RESULT ne "1"} { + puts "Fossil was not compiled with Tcl support." + test_cleanup_then_return } + +############################################################################### + +test_setup ############################################################################### set env(TH1_ENABLE_TCL) 1; # Tcl integration must be enabled for this test. @@ -173,5 +174,9 @@ ############################################################################### fossil test-th-eval "tclMakeSafe; tclEval set x 2; tclEval info vars x" test th1-tcl-17 {[normalize_result] eq {x}} + +############################################################################### + +test_cleanup Index: test/th1.test ================================================================== --- test/th1.test +++ test/th1.test @@ -16,11 +16,11 @@ ############################################################################ # # TH1 Commands # -set dir [file dirname [info script]]; repo_init +set dir [file dirname [info script]]; test_setup ############################################################################### set th1Tcl [is_tcl_usable_by_fossil] set th1Hooks [are_th1_hooks_usable_by_fossil] @@ -884,11 +884,11 @@ fossil test-th-eval "globalState vfs" test th1-globalState-14 {[string length $RESULT] == 0} ############################################################################### -if {$tcl_platform(platform) eq "windows"} then { +if {$tcl_platform(platform) eq "windows"} { set altVfs win32-longpath } else { set altVfs unix-dotfile } @@ -1451,5 +1451,9 @@ } fossil test-th-source $th1FileName test th1-source-1 {$RESULT eq {TH_RETURN: 0 1 2 3 4 5 6 7 8 9}} file delete $th1FileName + +############################################################################### + +test_cleanup Index: test/utf.test ================================================================== --- test/utf.test +++ test/utf.test @@ -15,10 +15,12 @@ # ############################################################################ # # Test UTF-8/UTF-16 detection # + +test_setup "" proc swap_byte_order {str} { set result "" for {set i 0} {$i < [string length $str]} {incr i} { set c [scan [string index $str $i] %c] @@ -23490,5 +23492,9 @@ Has flag LOOK_SHORT: no} ############################ END GENERATED SECTION ############################ deleteTestFiles $tempPath 100 + +############################################################################### + +test_cleanup