Fossil SCM
Improve handling of setting up the initial temporary directory.
Commit
e6e79ac6fbc1404991c84952a6bb9c3b925dea4a
Parent
b01a51f43ae0e9f…
1 file changed
+56
-4
+56
-4
| --- test/tester.tcl | ||
| +++ test/tester.tcl | ||
| @@ -386,10 +386,65 @@ | ||
| 386 | 386 | # Append all arguments into a single value and then returns it. |
| 387 | 387 | # |
| 388 | 388 | proc appendArgs {args} { |
| 389 | 389 | eval append result $args |
| 390 | 390 | } |
| 391 | + | |
| 392 | +# Returns the value of the specified environment variable -OR- any empty | |
| 393 | +# string if it does not exist. | |
| 394 | +# | |
| 395 | +proc getEnvironmentVariable { name } { | |
| 396 | + return [expr {[info exists ::env($name)] ? $::env($name) : ""}] | |
| 397 | +} | |
| 398 | + | |
| 399 | +# Returns a usable temporary directory -OR- fails the testing process. | |
| 400 | +# | |
| 401 | +proc getTemporaryPath {} { | |
| 402 | + # | |
| 403 | + # NOTE: Build the list of "temporary directory" environment variables | |
| 404 | + # to check, including all reasonable "cases" of the environment | |
| 405 | + # variable names. | |
| 406 | + # | |
| 407 | + set names [list] | |
| 408 | + | |
| 409 | + # | |
| 410 | + # TODO: Add more here, if necessary. | |
| 411 | + # | |
| 412 | + foreach name [list FOSSIL_TEST_TEMP FOSSIL_TEMP TEMP TMP] { | |
| 413 | + lappend names [string toupper $name] [string tolower $name] \ | |
| 414 | + [string totitle $name] | |
| 415 | + } | |
| 416 | + | |
| 417 | + # | |
| 418 | + # NOTE: Check if we can use any of the environment variables. | |
| 419 | + # | |
| 420 | + foreach name $names { | |
| 421 | + set value [getEnvironmentVariable $name] | |
| 422 | + | |
| 423 | + if {[string length $value] > 0} then { | |
| 424 | + if {[file exists $value] && [file isdirectory $value]} then { | |
| 425 | + return [file normalize $value] | |
| 426 | + } | |
| 427 | + } | |
| 428 | + } | |
| 429 | + | |
| 430 | + # | |
| 431 | + # NOTE: On non-Windows systems, fallback to /tmp if it is usable. | |
| 432 | + # | |
| 433 | + if {$::tcl_platform(platform) ne "windows"} { | |
| 434 | + set value /tmp | |
| 435 | + | |
| 436 | + if {[file exists $value] && [file isdirectory $value]} then { | |
| 437 | + return $value | |
| 438 | + } | |
| 439 | + } | |
| 440 | + | |
| 441 | + # | |
| 442 | + # NOTE: There must be a usable temporary directory to continue testing. | |
| 443 | + # | |
| 444 | + error "Cannot find a usable temporary directory, testing halted." | |
| 445 | +} | |
| 391 | 446 | |
| 392 | 447 | # Return the name of the versioned settings file containing the TH1 |
| 393 | 448 | # setup script. |
| 394 | 449 | # |
| 395 | 450 | proc getTh1SetupFileName {} { |
| @@ -600,19 +655,16 @@ | ||
| 600 | 655 | # returns the third to last line of the normalized result. |
| 601 | 656 | proc third_to_last_data_line {} { |
| 602 | 657 | return [lindex [split [normalize_result] \n] end-2] |
| 603 | 658 | } |
| 604 | 659 | |
| 605 | -set tempPath [expr {[info exists env(TEMP)] ? \ | |
| 606 | - $env(TEMP) : [file dirname [info script]]}] | |
| 660 | +set tempPath [getTemporaryPath] | |
| 607 | 661 | |
| 608 | 662 | if {$tcl_platform(platform) eq "windows"} { |
| 609 | 663 | set tempPath [string map [list \\ /] $tempPath] |
| 610 | 664 | } |
| 611 | 665 | |
| 612 | -set tempPath [file normalize $tempPath] | |
| 613 | - | |
| 614 | 666 | if {[catch { |
| 615 | 667 | set tempFile [file join $tempPath temporary.txt] |
| 616 | 668 | write_file $tempFile [clock seconds]; file delete $tempFile |
| 617 | 669 | } error] != 0} { |
| 618 | 670 | error "Could not write file \"$tempFile\" in directory \"$tempPath\",\ |
| 619 | 671 |
| --- test/tester.tcl | |
| +++ test/tester.tcl | |
| @@ -386,10 +386,65 @@ | |
| 386 | # Append all arguments into a single value and then returns it. |
| 387 | # |
| 388 | proc appendArgs {args} { |
| 389 | eval append result $args |
| 390 | } |
| 391 | |
| 392 | # Return the name of the versioned settings file containing the TH1 |
| 393 | # setup script. |
| 394 | # |
| 395 | proc getTh1SetupFileName {} { |
| @@ -600,19 +655,16 @@ | |
| 600 | # returns the third to last line of the normalized result. |
| 601 | proc third_to_last_data_line {} { |
| 602 | return [lindex [split [normalize_result] \n] end-2] |
| 603 | } |
| 604 | |
| 605 | set tempPath [expr {[info exists env(TEMP)] ? \ |
| 606 | $env(TEMP) : [file dirname [info script]]}] |
| 607 | |
| 608 | if {$tcl_platform(platform) eq "windows"} { |
| 609 | set tempPath [string map [list \\ /] $tempPath] |
| 610 | } |
| 611 | |
| 612 | set tempPath [file normalize $tempPath] |
| 613 | |
| 614 | if {[catch { |
| 615 | set tempFile [file join $tempPath temporary.txt] |
| 616 | write_file $tempFile [clock seconds]; file delete $tempFile |
| 617 | } error] != 0} { |
| 618 | error "Could not write file \"$tempFile\" in directory \"$tempPath\",\ |
| 619 |
| --- test/tester.tcl | |
| +++ test/tester.tcl | |
| @@ -386,10 +386,65 @@ | |
| 386 | # Append all arguments into a single value and then returns it. |
| 387 | # |
| 388 | proc appendArgs {args} { |
| 389 | eval append result $args |
| 390 | } |
| 391 | |
| 392 | # Returns the value of the specified environment variable -OR- any empty |
| 393 | # string if it does not exist. |
| 394 | # |
| 395 | proc getEnvironmentVariable { name } { |
| 396 | return [expr {[info exists ::env($name)] ? $::env($name) : ""}] |
| 397 | } |
| 398 | |
| 399 | # Returns a usable temporary directory -OR- fails the testing process. |
| 400 | # |
| 401 | proc getTemporaryPath {} { |
| 402 | # |
| 403 | # NOTE: Build the list of "temporary directory" environment variables |
| 404 | # to check, including all reasonable "cases" of the environment |
| 405 | # variable names. |
| 406 | # |
| 407 | set names [list] |
| 408 | |
| 409 | # |
| 410 | # TODO: Add more here, if necessary. |
| 411 | # |
| 412 | foreach name [list FOSSIL_TEST_TEMP FOSSIL_TEMP TEMP TMP] { |
| 413 | lappend names [string toupper $name] [string tolower $name] \ |
| 414 | [string totitle $name] |
| 415 | } |
| 416 | |
| 417 | # |
| 418 | # NOTE: Check if we can use any of the environment variables. |
| 419 | # |
| 420 | foreach name $names { |
| 421 | set value [getEnvironmentVariable $name] |
| 422 | |
| 423 | if {[string length $value] > 0} then { |
| 424 | if {[file exists $value] && [file isdirectory $value]} then { |
| 425 | return [file normalize $value] |
| 426 | } |
| 427 | } |
| 428 | } |
| 429 | |
| 430 | # |
| 431 | # NOTE: On non-Windows systems, fallback to /tmp if it is usable. |
| 432 | # |
| 433 | if {$::tcl_platform(platform) ne "windows"} { |
| 434 | set value /tmp |
| 435 | |
| 436 | if {[file exists $value] && [file isdirectory $value]} then { |
| 437 | return $value |
| 438 | } |
| 439 | } |
| 440 | |
| 441 | # |
| 442 | # NOTE: There must be a usable temporary directory to continue testing. |
| 443 | # |
| 444 | error "Cannot find a usable temporary directory, testing halted." |
| 445 | } |
| 446 | |
| 447 | # Return the name of the versioned settings file containing the TH1 |
| 448 | # setup script. |
| 449 | # |
| 450 | proc getTh1SetupFileName {} { |
| @@ -600,19 +655,16 @@ | |
| 655 | # returns the third to last line of the normalized result. |
| 656 | proc third_to_last_data_line {} { |
| 657 | return [lindex [split [normalize_result] \n] end-2] |
| 658 | } |
| 659 | |
| 660 | set tempPath [getTemporaryPath] |
| 661 | |
| 662 | if {$tcl_platform(platform) eq "windows"} { |
| 663 | set tempPath [string map [list \\ /] $tempPath] |
| 664 | } |
| 665 | |
| 666 | if {[catch { |
| 667 | set tempFile [file join $tempPath temporary.txt] |
| 668 | write_file $tempFile [clock seconds]; file delete $tempFile |
| 669 | } error] != 0} { |
| 670 | error "Could not write file \"$tempFile\" in directory \"$tempPath\",\ |
| 671 |