Fossil

Check-in [a88ca0d7]
Login

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

Overview
Comment:Adjustments to the 'test_start_server' Fossil test suite procedure to make it work better on Windows.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:a88ca0d7dd4172265cf70abded82a6698b5e0e65
User & Date: mistachkin 2016-10-14 19:35:15
Context
2016-10-14
20:34
Merge fork check-in: 3a35ac58 user: andygoth tags: trunk
19:35
Adjustments to the 'test_start_server' Fossil test suite procedure to make it work better on Windows. check-in: a88ca0d7 user: mistachkin tags: trunk
19:04
Update test_start_server procedure to return the port as well because fossil server dynamically allocates a port. check-in: b66d5bca user: andybradford tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to test/tester.tcl.

752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770

771
772
773
774
775
776
777
778


779
780

781
782
783
784
785
786
787

# This procedure executes the "fossil server" command.  The return value
# is a list comprised of the new process identifier and the port on which
# the server started.  The varName argument refers to a variable
# where the "stop argument" is to be stored.  This value must eventually be
# passed to the [test_stop_server] procedure.
proc test_start_server { repository {varName ""} } {
  global fossilexe tempHomePath
  set command [list exec $fossilexe server]
  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 tmpFile [file join $tempHomePath [appendArgs \
      uvtest_ [string trim [clock seconds] -] _ [getSeqNo]]].out

  lappend command $repository >&$tmpFile &
  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 $tmpFile]
  catch {file delete $tmpFile}


  set port 8080; # return the default port just in case
  regexp {Listening.*TCP port (\d+)} $output m port

  return [list $pid $port]
}

# 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.
proc test_stop_server { stopArg pid } {







|









|
|
>
|





|
|
>
>
|
<
>







752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782

783
784
785
786
787
788
789
790

# This procedure executes the "fossil server" command.  The return value
# is a list comprised of the new process identifier and the port on which
# the server started.  The varName argument refers to a variable
# where the "stop argument" is to be stored.  This value must eventually be
# passed to the [test_stop_server] procedure.
proc test_start_server { repository {varName ""} } {
  global fossilexe tempPath
  set command [list exec $fossilexe server]
  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]
  catch {file delete $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

  }
  return [list $pid $port]
}

# 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.
proc test_stop_server { stopArg pid } {