Fossil: Check-in [2e4143aa]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview

Comment:	Cached the result of "$tcl_platform(platform) eq "windows"" in test/tester.tcl and replaced all of the repetitions of this expression with a test of the variable.
Downloads:	Tarball \| ZIP archive \| SQL archive
Timelines:	family \| ancestors \| descendants \| both \| trunk
Files:	files \| file ages \| folders
SHA3-256:	2e4143aa4b8800dc7b6453bc612386371a5b4960e9a26dcebdd5121e417da3ed
User & Date:	wyoung 2018-09-02 23:05:53

Context

2018-09-03
00:24		The -quiet flag passed by default to tester.tcl can now be overridden by passing TESTFLAGS to make. Before, there was no way to set -verbose this way because "-quiet -verbose" means the same thing as "-quiet". check-in: 401a4c3d user: wyoung tags: trunk
2018-09-02
23:05		Cached the result of "$tcl_platform(platform) eq "windows"" in test/tester.tcl and replaced all of the repetitions of this expression with a test of the variable. check-in: 2e4143aa user: wyoung tags: trunk
21:51		Removed a debug message accidentally checked in. check-in: 8eadf4c4 user: wyoung tags: trunk

Changes

Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to test/tester.tcl.

# have found us a suitable Tcl installation.
package require Tcl 8.6

set testfiledir [file normalize [file dirname [info script]]]
set testrundir [pwd]
set testdir [file normalize [file dirname $argv0]]
set fossilexe [file normalize [lindex $argv 0]]


if {$tcl_platform(platform) eq "windows" && \

    [string length [file extension $fossilexe]] == 0} {
  append fossilexe .exe
}

set argv [lrange $argv 1 end]

set i [lsearch $argv -keep]
................................................................................
  # 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
}

................................................................................
      }
    }
  }

  #
  # 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]} {
      return $value
    }
  }

................................................................................
# passed to the [test_stop_server] procedure.
proc test_start_server { repository {varName ""} } {
  global fossilexe tempPath
  set command [list exec $fossilexe server --localhost]
  if {[string length $varName] > 0} {
    upvar 1 $varName stopArg
  }
  if {$::tcl_platform(platform) eq "windows"} {
    set stopArg [file join [getTemporaryPath] [appendArgs \
        [string trim [clock seconds] -] _ [getSeqNo] .stopper]]
    lappend command --stopper $stopArg
  }
  set outFileName [file join $tempPath [appendArgs \
      fossil_server_ [string trim [clock seconds] -] _ \
      [getSeqNo]]].out
  lappend command $repository >&$outFileName &
  set pid [eval $command]
  if {$::tcl_platform(platform) ne "windows"} {
    set stopArg $pid
  }
  after 1000; # output might not be there yet
  set output [read_file $outFileName]
  if {![regexp {Listening.*TCP port (\d+)} $output dummy port]} {
    puts stdout "Could not detect Fossil server port, using default..."
    set port 8080; # return the default port just in case
................................................................................
}

# This procedure stops a Fossil server instance that was previously started
# by the [test_start_server] procedure.  The value of the "stop argument"
# will vary by platform as will the exact method used to stop the server.
# The fileName argument is the name of a temporary output file to delete.
proc test_stop_server { stopArg pid fileName } {
  if {$::tcl_platform(platform) eq "windows"} {
    #
    # NOTE: On Windows, the "stop argument" must be the name of a file
    #       that does NOT already exist.
    #
    if {[string length $stopArg] > 0 && \
        ![file exists $stopArg] && \
        [catch {write_file $stopArg [clock seconds]}] == 0} {
................................................................................
# 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 [getTemporaryPath]

if {$tcl_platform(platform) eq "windows"} {
  set tempPath [string map [list \\ /] $tempPath]
}

if {[catch {
  set tempFile [file join $tempPath temporary.txt]
  write_file $tempFile [clock seconds]; file delete $tempFile
} error] != 0} {

# have found us a suitable Tcl installation.
package require Tcl 8.6

set testfiledir [file normalize [file dirname [info script]]]
set testrundir [pwd]
set testdir [file normalize [file dirname $argv0]]
set fossilexe [file normalize [lindex $argv 0]]
set is_windows [expr {$::tcl_platform(platform) eq "windows"}]


if {$is_windows && \
    [string length [file extension $fossilexe]] == 0} {
  append fossilexe .exe
}

set argv [lrange $argv 1 end]

set i [lsearch $argv -keep]
................................................................................
  # 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 {$::is_windows} {
    robust_delete [file join $::tempHomePath _fossil]
  } else {
    robust_delete [file join $::tempHomePath .fossil]
  }
  robust_delete $::tempHomePath
}

................................................................................
      }
    }
  }

  #
  # NOTE: On non-Windows systems, fallback to /tmp if it is usable.
  #
  if {!$::is_windows} {
    set value /tmp

    if {[file exists $value] && [file isdirectory $value]} {
      return $value
    }
  }

................................................................................
# passed to the [test_stop_server] procedure.
proc test_start_server { repository {varName ""} } {
  global fossilexe tempPath
  set command [list exec $fossilexe server --localhost]
  if {[string length $varName] > 0} {
    upvar 1 $varName stopArg
  }
  if {$::is_windows} {
    set stopArg [file join [getTemporaryPath] [appendArgs \
        [string trim [clock seconds] -] _ [getSeqNo] .stopper]]
    lappend command --stopper $stopArg
  }
  set outFileName [file join $tempPath [appendArgs \
      fossil_server_ [string trim [clock seconds] -] _ \
      [getSeqNo]]].out
  lappend command $repository >&$outFileName &
  set pid [eval $command]
  if {!$::is_windows} {
    set stopArg $pid
  }
  after 1000; # output might not be there yet
  set output [read_file $outFileName]
  if {![regexp {Listening.*TCP port (\d+)} $output dummy port]} {
    puts stdout "Could not detect Fossil server port, using default..."
    set port 8080; # return the default port just in case
................................................................................
}

# This procedure stops a Fossil server instance that was previously started
# by the [test_start_server] procedure.  The value of the "stop argument"
# will vary by platform as will the exact method used to stop the server.
# The fileName argument is the name of a temporary output file to delete.
proc test_stop_server { stopArg pid fileName } {
  if {$::is_windows} {
    #
    # NOTE: On Windows, the "stop argument" must be the name of a file
    #       that does NOT already exist.
    #
    if {[string length $stopArg] > 0 && \
        ![file exists $stopArg] && \
        [catch {write_file $stopArg [clock seconds]}] == 0} {
................................................................................
# 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 [getTemporaryPath]

if {$is_windows} {
  set tempPath [string map [list \\ /] $tempPath]
}

if {[catch {
  set tempFile [file join $tempPath temporary.txt]
  write_file $tempFile [clock seconds]; file delete $tempFile
} error] != 0} {