Fossil SCM

Further revise the 'test_start_server' and 'test_stop_server' test suite helper procedures to make it possible to actually delete the temporary output-capture file on Windows.

mistachkin 2016-10-15 04:56 trunk
Commit b0081d9786a665d4587a0ba5c01ef76d95c688ae
Parent 6c8cec734114b5c…
2 files changed +11 -4 +2 -2
~ test/tester.tcl ~ test/unversioned.test
M test/tester.tcl
+11 -4
--- test/tester.tcl
+++ test/tester.tcl
@@ -774,28 +774,29 @@
774774
 if {$::tcl_platform(platform) ne "windows"} {
775775
 set stopArg $pid
776776
 }
777777
 after 1000; # output might not be there yet
778778
 set output [read_file $outFileName]
779
- catch {file delete $outFileName}
780779
 if {![regexp {Listening.*TCP port (\d+)} $output dummy port]} {
781780
 puts stdout "Could not detect Fossil server port, using default..."
782781
 set port 8080; # return the default port just in case
783782
 }
784
- return [list $pid $port]
783
+ return [list $pid $port $outFileName]
785784
 }
786785
787786
 # This procedure stops a Fossil server instance that was previously started
788787
 # by the [test_start_server] procedure. The value of the "stop argument"
789788
 # will vary by platform as will the exact method used to stop the server.
790
-proc test_stop_server { stopArg pid } {
789
+# The fileName argument is the name of a temporary output file to delete.
790
+proc test_stop_server { stopArg pid fileName } {
791791
 if {$::tcl_platform(platform) eq "windows"} {
792792
 #
793793
 # NOTE: On Windows, the "stop argument" must be the name of a file
794794
 # that does NOT already exist.
795795
 #
796
- if {![file exists $stopArg] && \
796
+ if {[string length $stopArg] > 0 && \
797
+ ![file exists $stopArg] && \
797798
 [catch {write_file $stopArg [clock seconds]}] == 0} then {
798799
 while {1} {
799800
 if {[catch {
800801
 #
801802
 # NOTE: Using the TaskList utility requires Windows XP or
@@ -806,10 +807,13 @@
806807
 break
807808
 }
808809
 after 1000; # wait a bit...
809810
 }
810811
 file delete $stopArg
812
+ if {[string length $fileName] > 0} then {
813
+ file delete $fileName
814
+ }
811815
 return true
812816
 }
813817
 } else {
814818
 #
815819
 # NOTE: On Unix, the "stop argument" must be an integer identifier
@@ -826,10 +830,13 @@
826830
 exec ps -p $pid
827831
 } result] != 0 || ![regexp -- "(?:^$pid| $pid) " $result]} then {
828832
 break
829833
 }
830834
 after 1000; # wait a bit...
835
+ }
836
+ if {[string length $fileName] > 0} then {
837
+ file delete $fileName
831838
 }
832839
 return true
833840
 }
834841
 }
835842
 return false
836843
--- test/tester.tcl
+++ test/tester.tcl
@@ -774,28 +774,29 @@
774 if {$::tcl_platform(platform) ne "windows"} {
775 set stopArg $pid
776 }
777 after 1000; # output might not be there yet
778 set output [read_file $outFileName]
779 catch {file delete $outFileName}
780 if {![regexp {Listening.*TCP port (\d+)} $output dummy port]} {
781 puts stdout "Could not detect Fossil server port, using default..."
782 set port 8080; # return the default port just in case
783 }
784 return [list $pid $port]
785 }
786
787 # This procedure stops a Fossil server instance that was previously started
788 # by the [test_start_server] procedure. The value of the "stop argument"
789 # will vary by platform as will the exact method used to stop the server.
790 proc test_stop_server { stopArg pid } {
 
791 if {$::tcl_platform(platform) eq "windows"} {
792 #
793 # NOTE: On Windows, the "stop argument" must be the name of a file
794 # that does NOT already exist.
795 #
796 if {![file exists $stopArg] && \
 
797 [catch {write_file $stopArg [clock seconds]}] == 0} then {
798 while {1} {
799 if {[catch {
800 #
801 # NOTE: Using the TaskList utility requires Windows XP or
@@ -806,10 +807,13 @@
806 break
807 }
808 after 1000; # wait a bit...
809 }
810 file delete $stopArg
 
 
 
811 return true
812 }
813 } else {
814 #
815 # NOTE: On Unix, the "stop argument" must be an integer identifier
@@ -826,10 +830,13 @@
826 exec ps -p $pid
827 } result] != 0 || ![regexp -- "(?:^$pid| $pid) " $result]} then {
828 break
829 }
830 after 1000; # wait a bit...
 
 
 
831 }
832 return true
833 }
834 }
835 return false
836
--- test/tester.tcl
+++ test/tester.tcl
@@ -774,28 +774,29 @@
774 if {$::tcl_platform(platform) ne "windows"} {
775 set stopArg $pid
776 }
777 after 1000; # output might not be there yet
778 set output [read_file $outFileName]
 
779 if {![regexp {Listening.*TCP port (\d+)} $output dummy port]} {
780 puts stdout "Could not detect Fossil server port, using default..."
781 set port 8080; # return the default port just in case
782 }
783 return [list $pid $port $outFileName]
784 }
785
786 # This procedure stops a Fossil server instance that was previously started
787 # by the [test_start_server] procedure. The value of the "stop argument"
788 # will vary by platform as will the exact method used to stop the server.
789 # The fileName argument is the name of a temporary output file to delete.
790 proc test_stop_server { stopArg pid fileName } {
791 if {$::tcl_platform(platform) eq "windows"} {
792 #
793 # NOTE: On Windows, the "stop argument" must be the name of a file
794 # that does NOT already exist.
795 #
796 if {[string length $stopArg] > 0 && \
797 ![file exists $stopArg] && \
798 [catch {write_file $stopArg [clock seconds]}] == 0} then {
799 while {1} {
800 if {[catch {
801 #
802 # NOTE: Using the TaskList utility requires Windows XP or
@@ -806,10 +807,13 @@
807 break
808 }
809 after 1000; # wait a bit...
810 }
811 file delete $stopArg
812 if {[string length $fileName] > 0} then {
813 file delete $fileName
814 }
815 return true
816 }
817 } else {
818 #
819 # NOTE: On Unix, the "stop argument" must be an integer identifier
@@ -826,10 +830,13 @@
830 exec ps -p $pid
831 } result] != 0 || ![regexp -- "(?:^$pid| $pid) " $result]} then {
832 break
833 }
834 after 1000; # wait a bit...
835 }
836 if {[string length $fileName] > 0} then {
837 file delete $fileName
838 }
839 return true
840 }
841 }
842 return false
843
M test/unversioned.test
+2 -2
--- test/unversioned.test
+++ test/unversioned.test
@@ -311,11 +311,11 @@
311311
 fossil user new uvtester "Unversioned Test User" $password
312312
 fossil user capabilities uvtester oy
313313
314314
 ###############################################################################
315315
316
-foreach {pid port} [test_start_server $repository stopArg] {}
316
+foreach {pid port outTmpFile} [test_start_server $repository stopArg] {}
317317
 puts [appendArgs "Started Fossil server, pid \"" $pid \" ", port \"" $port \".]
318318
 set remote [appendArgs http://uvtester: $password @localhost: $port /]
319319
320320
 ###############################################################################
321321
@@ -427,11 +427,11 @@
427427
 file delete -force $clientDir
428428
 puts [appendArgs "Now in server directory \"" [pwd] \".]
429429
430430
 ###############################################################################
431431
432
-set stopped [test_stop_server $stopArg $pid]
432
+set stopped [test_stop_server $stopArg $pid $outTmpFile]
433433
434434
 puts [appendArgs \
435435
 [expr {$stopped ? "Stopped" : "Could not stop"}] \
436436
 " Fossil server, pid \"" $pid "\", using argument \"" \
437437
 $stopArg \".]
438438
--- test/unversioned.test
+++ test/unversioned.test
@@ -311,11 +311,11 @@
311 fossil user new uvtester "Unversioned Test User" $password
312 fossil user capabilities uvtester oy
313
314 ###############################################################################
315
316 foreach {pid port} [test_start_server $repository stopArg] {}
317 puts [appendArgs "Started Fossil server, pid \"" $pid \" ", port \"" $port \".]
318 set remote [appendArgs http://uvtester: $password @localhost: $port /]
319
320 ###############################################################################
321
@@ -427,11 +427,11 @@
427 file delete -force $clientDir
428 puts [appendArgs "Now in server directory \"" [pwd] \".]
429
430 ###############################################################################
431
432 set stopped [test_stop_server $stopArg $pid]
433
434 puts [appendArgs \
435 [expr {$stopped ? "Stopped" : "Could not stop"}] \
436 " Fossil server, pid \"" $pid "\", using argument \"" \
437 $stopArg \".]
438
--- test/unversioned.test
+++ test/unversioned.test
@@ -311,11 +311,11 @@
311 fossil user new uvtester "Unversioned Test User" $password
312 fossil user capabilities uvtester oy
313
314 ###############################################################################
315
316 foreach {pid port outTmpFile} [test_start_server $repository stopArg] {}
317 puts [appendArgs "Started Fossil server, pid \"" $pid \" ", port \"" $port \".]
318 set remote [appendArgs http://uvtester: $password @localhost: $port /]
319
320 ###############################################################################
321
@@ -427,11 +427,11 @@
427 file delete -force $clientDir
428 puts [appendArgs "Now in server directory \"" [pwd] \".]
429
430 ###############################################################################
431
432 set stopped [test_stop_server $stopArg $pid $outTmpFile]
433
434 puts [appendArgs \
435 [expr {$stopped ? "Stopped" : "Could not stop"}] \
436 " Fossil server, pid \"" $pid "\", using argument \"" \
437 $stopArg \".]
438

Keyboard Shortcuts

Open search /
Next entry (timeline) j
Previous entry (timeline) k
Open focused entry Enter
Show this help ?
Toggle theme Top nav button