Fossil SCM

applied patch from ticket [aa01499923] and added option -prot to test tcl script which optionally writes a protocol file

wolfgang 2010-10-30 19:05 trunk
Commit f89d953a061c5bb039d652e74f0125da7a6d2d43
Parent 8c723318d27cc52…
5 files changed +1 -1 +12 -12 +4 -4 +8 -8 +38 -5
~ test/delta1.test ~ test/merge1.test ~ test/merge3.test ~ test/merge4.test ~ test/tester.tcl
M test/delta1.test
+1 -1
--- test/delta1.test
+++ test/delta1.test
@@ -32,11 +32,11 @@
3232
 # work properly.
3333
 #
3434
 set filelist [glob $testdir/*]
3535
 foreach f $filelist {
3636
 set base [file root [file tail $f]]
37
-puts "base=$base f=$f"
37
+protOut "base=$base f=$f"
3838
 set f1 [read_file $f]
3939
 write_file t1 $f1
4040
 for {set i 0} {$i<100} {incr i} {
4141
 write_file t2 [random_changes $f1 1 1 0 0.1]
4242
 fossil test-delta t1 t2
4343
--- test/delta1.test
+++ test/delta1.test
@@ -32,11 +32,11 @@
32 # work properly.
33 #
34 set filelist [glob $testdir/*]
35 foreach f $filelist {
36 set base [file root [file tail $f]]
37 puts "base=$base f=$f"
38 set f1 [read_file $f]
39 write_file t1 $f1
40 for {set i 0} {$i<100} {incr i} {
41 write_file t2 [random_changes $f1 1 1 0 0.1]
42 fossil test-delta t1 t2
43
--- test/delta1.test
+++ test/delta1.test
@@ -32,11 +32,11 @@
32 # work properly.
33 #
34 set filelist [glob $testdir/*]
35 foreach f $filelist {
36 set base [file root [file tail $f]]
37 protOut "base=$base f=$f"
38 set f1 [read_file $f]
39 write_file t1 $f1
40 for {set i 0} {$i<100} {incr i} {
41 write_file t2 [random_changes $f1 1 1 0 0.1]
42 fossil test-delta t1 t2
43
M test/merge1.test
+12 -12
--- test/merge1.test
+++ test/merge1.test
@@ -77,26 +77,26 @@
7777
 333 - This is a test of the merging algohm - 3333
7878
 444 - If all goes well, we will be pleased - 4444
7979
 555 - we think it well and other stuff too - 5555
8080
 }
8181
 write_file_indented t23 {
82
- >>>>>>> BEGIN MERGE CONFLICT
82
+ <<<<<<< BEGIN MERGE CONFLICT
8383
 111 - This is line ONE of the demo program - 1111
8484
 ============================
8585
 111 - This is line one OF the demo program - 1111
86
- <<<<<<< END MERGE CONFLICT
86
+ >>>>>>> END MERGE CONFLICT
8787
 222 - The second line program line in code - 2222
8888
 333 - This is a test of the merging algohm - 3333
8989
 444 - If all goes well, we will be pleased - 4444
9090
 555 - we think it well and other stuff too - 5555
9191
 }
9292
 write_file_indented t32 {
93
- >>>>>>> BEGIN MERGE CONFLICT
93
+ <<<<<<< BEGIN MERGE CONFLICT
9494
 111 - This is line one OF the demo program - 1111
9595
 ============================
9696
 111 - This is line ONE of the demo program - 1111
97
- <<<<<<< END MERGE CONFLICT
97
+ >>>>>>> END MERGE CONFLICT
9898
 222 - The second line program line in code - 2222
9999
 333 - This is a test of the merging algohm - 3333
100100
 444 - If all goes well, we will be pleased - 4444
101101
 555 - we think it well and other stuff too - 5555
102102
 }
@@ -158,26 +158,26 @@
158158
 333 - This is a test of the merging algohm - 3333
159159
 444 - If all goes well, we will be pleased - 4444
160160
 555 - we think it well and other stuff too - 5555
161161
 }
162162
 write_file_indented t32 {
163
- >>>>>>> BEGIN MERGE CONFLICT
163
+ <<<<<<< BEGIN MERGE CONFLICT
164164
 ============================
165165
 000 - Zero lines added to the beginning of - 0000
166166
 111 - This is line one of the demo program - 1111
167
- <<<<<<< END MERGE CONFLICT
167
+ >>>>>>> END MERGE CONFLICT
168168
 222 - The second line program line in code - 2222
169169
 333 - This is a test of the merging algohm - 3333
170170
 444 - If all goes well, we will be pleased - 4444
171171
 555 - we think it well and other stuff too - 5555
172172
 }
173173
 write_file_indented t23 {
174
- >>>>>>> BEGIN MERGE CONFLICT
174
+ <<<<<<< BEGIN MERGE CONFLICT
175175
 000 - Zero lines added to the beginning of - 0000
176176
 111 - This is line one of the demo program - 1111
177177
 ============================
178
- <<<<<<< END MERGE CONFLICT
178
+ >>>>>>> END MERGE CONFLICT
179179
 222 - The second line program line in code - 2222
180180
 333 - This is a test of the merging algohm - 3333
181181
 444 - If all goes well, we will be pleased - 4444
182182
 555 - we think it well and other stuff too - 5555
183183
 }
@@ -293,11 +293,11 @@
293293
 STUV
294294
 XYZ.
295295
 }
296296
 write_file_indented t23 {
297297
 abcd
298
- >>>>>>> BEGIN MERGE CONFLICT
298
+ <<<<<<< BEGIN MERGE CONFLICT
299299
 efgh 2
300300
 ijkl 2
301301
 mnop 2
302302
 qrst
303303
 uvwx
@@ -311,11 +311,11 @@
311311
 qrst 3
312312
 uvwx 3
313313
 yzAB 3
314314
 CDEF
315315
 GHIJ
316
- <<<<<<< END MERGE CONFLICT
316
+ >>>>>>> END MERGE CONFLICT
317317
 KLMN
318318
 OPQR
319319
 STUV
320320
 XYZ.
321321
 }
@@ -354,11 +354,11 @@
354354
 }
355355
 write_file_indented t23 {
356356
 abcd
357357
 efgh 2
358358
 ijkl 2
359
- >>>>>>> BEGIN MERGE CONFLICT
359
+ <<<<<<< BEGIN MERGE CONFLICT
360360
 mnop
361361
 qrst
362362
 uvwx
363363
 yzAB 2
364364
 CDEF 2
@@ -368,13 +368,13 @@
368368
 qrst 3
369369
 uvwx 3
370370
 yzAB 3
371371
 CDEF
372372
 GHIJ
373
- <<<<<<< END MERGE CONFLICT
373
+ >>>>>>> END MERGE CONFLICT
374374
 KLMN
375375
 OPQR
376376
 STUV
377377
 XYZ.
378378
 }
379379
 fossil test-3 t1 t2 t3 a23
380380
 test merge1-7.2 {[same_file t23 a23]}
381381
--- test/merge1.test
+++ test/merge1.test
@@ -77,26 +77,26 @@
77 333 - This is a test of the merging algohm - 3333
78 444 - If all goes well, we will be pleased - 4444
79 555 - we think it well and other stuff too - 5555
80 }
81 write_file_indented t23 {
82 >>>>>>> BEGIN MERGE CONFLICT
83 111 - This is line ONE of the demo program - 1111
84 ============================
85 111 - This is line one OF the demo program - 1111
86 <<<<<<< END MERGE CONFLICT
87 222 - The second line program line in code - 2222
88 333 - This is a test of the merging algohm - 3333
89 444 - If all goes well, we will be pleased - 4444
90 555 - we think it well and other stuff too - 5555
91 }
92 write_file_indented t32 {
93 >>>>>>> BEGIN MERGE CONFLICT
94 111 - This is line one OF the demo program - 1111
95 ============================
96 111 - This is line ONE of the demo program - 1111
97 <<<<<<< END MERGE CONFLICT
98 222 - The second line program line in code - 2222
99 333 - This is a test of the merging algohm - 3333
100 444 - If all goes well, we will be pleased - 4444
101 555 - we think it well and other stuff too - 5555
102 }
@@ -158,26 +158,26 @@
158 333 - This is a test of the merging algohm - 3333
159 444 - If all goes well, we will be pleased - 4444
160 555 - we think it well and other stuff too - 5555
161 }
162 write_file_indented t32 {
163 >>>>>>> BEGIN MERGE CONFLICT
164 ============================
165 000 - Zero lines added to the beginning of - 0000
166 111 - This is line one of the demo program - 1111
167 <<<<<<< END MERGE CONFLICT
168 222 - The second line program line in code - 2222
169 333 - This is a test of the merging algohm - 3333
170 444 - If all goes well, we will be pleased - 4444
171 555 - we think it well and other stuff too - 5555
172 }
173 write_file_indented t23 {
174 >>>>>>> BEGIN MERGE CONFLICT
175 000 - Zero lines added to the beginning of - 0000
176 111 - This is line one of the demo program - 1111
177 ============================
178 <<<<<<< END MERGE CONFLICT
179 222 - The second line program line in code - 2222
180 333 - This is a test of the merging algohm - 3333
181 444 - If all goes well, we will be pleased - 4444
182 555 - we think it well and other stuff too - 5555
183 }
@@ -293,11 +293,11 @@
293 STUV
294 XYZ.
295 }
296 write_file_indented t23 {
297 abcd
298 >>>>>>> BEGIN MERGE CONFLICT
299 efgh 2
300 ijkl 2
301 mnop 2
302 qrst
303 uvwx
@@ -311,11 +311,11 @@
311 qrst 3
312 uvwx 3
313 yzAB 3
314 CDEF
315 GHIJ
316 <<<<<<< END MERGE CONFLICT
317 KLMN
318 OPQR
319 STUV
320 XYZ.
321 }
@@ -354,11 +354,11 @@
354 }
355 write_file_indented t23 {
356 abcd
357 efgh 2
358 ijkl 2
359 >>>>>>> BEGIN MERGE CONFLICT
360 mnop
361 qrst
362 uvwx
363 yzAB 2
364 CDEF 2
@@ -368,13 +368,13 @@
368 qrst 3
369 uvwx 3
370 yzAB 3
371 CDEF
372 GHIJ
373 <<<<<<< END MERGE CONFLICT
374 KLMN
375 OPQR
376 STUV
377 XYZ.
378 }
379 fossil test-3 t1 t2 t3 a23
380 test merge1-7.2 {[same_file t23 a23]}
381
--- test/merge1.test
+++ test/merge1.test
@@ -77,26 +77,26 @@
77 333 - This is a test of the merging algohm - 3333
78 444 - If all goes well, we will be pleased - 4444
79 555 - we think it well and other stuff too - 5555
80 }
81 write_file_indented t23 {
82 <<<<<<< BEGIN MERGE CONFLICT
83 111 - This is line ONE of the demo program - 1111
84 ============================
85 111 - This is line one OF the demo program - 1111
86 >>>>>>> END MERGE CONFLICT
87 222 - The second line program line in code - 2222
88 333 - This is a test of the merging algohm - 3333
89 444 - If all goes well, we will be pleased - 4444
90 555 - we think it well and other stuff too - 5555
91 }
92 write_file_indented t32 {
93 <<<<<<< BEGIN MERGE CONFLICT
94 111 - This is line one OF the demo program - 1111
95 ============================
96 111 - This is line ONE of the demo program - 1111
97 >>>>>>> END MERGE CONFLICT
98 222 - The second line program line in code - 2222
99 333 - This is a test of the merging algohm - 3333
100 444 - If all goes well, we will be pleased - 4444
101 555 - we think it well and other stuff too - 5555
102 }
@@ -158,26 +158,26 @@
158 333 - This is a test of the merging algohm - 3333
159 444 - If all goes well, we will be pleased - 4444
160 555 - we think it well and other stuff too - 5555
161 }
162 write_file_indented t32 {
163 <<<<<<< BEGIN MERGE CONFLICT
164 ============================
165 000 - Zero lines added to the beginning of - 0000
166 111 - This is line one of the demo program - 1111
167 >>>>>>> END MERGE CONFLICT
168 222 - The second line program line in code - 2222
169 333 - This is a test of the merging algohm - 3333
170 444 - If all goes well, we will be pleased - 4444
171 555 - we think it well and other stuff too - 5555
172 }
173 write_file_indented t23 {
174 <<<<<<< BEGIN MERGE CONFLICT
175 000 - Zero lines added to the beginning of - 0000
176 111 - This is line one of the demo program - 1111
177 ============================
178 >>>>>>> END MERGE CONFLICT
179 222 - The second line program line in code - 2222
180 333 - This is a test of the merging algohm - 3333
181 444 - If all goes well, we will be pleased - 4444
182 555 - we think it well and other stuff too - 5555
183 }
@@ -293,11 +293,11 @@
293 STUV
294 XYZ.
295 }
296 write_file_indented t23 {
297 abcd
298 <<<<<<< BEGIN MERGE CONFLICT
299 efgh 2
300 ijkl 2
301 mnop 2
302 qrst
303 uvwx
@@ -311,11 +311,11 @@
311 qrst 3
312 uvwx 3
313 yzAB 3
314 CDEF
315 GHIJ
316 >>>>>>> END MERGE CONFLICT
317 KLMN
318 OPQR
319 STUV
320 XYZ.
321 }
@@ -354,11 +354,11 @@
354 }
355 write_file_indented t23 {
356 abcd
357 efgh 2
358 ijkl 2
359 <<<<<<< BEGIN MERGE CONFLICT
360 mnop
361 qrst
362 uvwx
363 yzAB 2
364 CDEF 2
@@ -368,13 +368,13 @@
368 qrst 3
369 uvwx 3
370 yzAB 3
371 CDEF
372 GHIJ
373 >>>>>>> END MERGE CONFLICT
374 KLMN
375 OPQR
376 STUV
377 XYZ.
378 }
379 fossil test-3 t1 t2 t3 a23
380 test merge1-7.2 {[same_file t23 a23]}
381
M test/merge3.test
+4 -4
--- test/merge3.test
+++ test/merge3.test
@@ -28,18 +28,18 @@
2828
 write_file t1 [join [string trim $basis] \n]\n
2929
 write_file t2 [join [string trim $v1] \n]\n
3030
 write_file t3 [join [string trim $v2] \n]\n
3131
 fossil test-3-way-merge t1 t2 t3 t4
3232
 set x [read_file t4]
33
- regsub -all {>>>>>>> BEGIN MERGE CONFLICT} $x {>} x
33
+ regsub -all {<<<<<<< BEGIN MERGE CONFLICT} $x {>} x
3434
 regsub -all {============================} $x {=} x
35
- regsub -all {<<<<<<< END MERGE CONFLICT} $x {<} x
35
+ regsub -all {>>>>>>> END MERGE CONFLICT} $x {<} x
3636
 set x [split [string trim $x] \n]
3737
 set result [string trim $result]
3838
 if {$x!=$result} {
39
- puts " Expected \[$result\]"
40
- puts " Got \[$x\]"
39
+ protOut " Expected \[$result\]"
40
+ protOut " Got \[$x\]"
4141
 test merge3-$testid 0
4242
 } else {
4343
 test merge3-$testid 1
4444
 }
4545
 }
4646
--- test/merge3.test
+++ test/merge3.test
@@ -28,18 +28,18 @@
28 write_file t1 [join [string trim $basis] \n]\n
29 write_file t2 [join [string trim $v1] \n]\n
30 write_file t3 [join [string trim $v2] \n]\n
31 fossil test-3-way-merge t1 t2 t3 t4
32 set x [read_file t4]
33 regsub -all {>>>>>>> BEGIN MERGE CONFLICT} $x {>} x
34 regsub -all {============================} $x {=} x
35 regsub -all {<<<<<<< END MERGE CONFLICT} $x {<} x
36 set x [split [string trim $x] \n]
37 set result [string trim $result]
38 if {$x!=$result} {
39 puts " Expected \[$result\]"
40 puts " Got \[$x\]"
41 test merge3-$testid 0
42 } else {
43 test merge3-$testid 1
44 }
45 }
46
--- test/merge3.test
+++ test/merge3.test
@@ -28,18 +28,18 @@
28 write_file t1 [join [string trim $basis] \n]\n
29 write_file t2 [join [string trim $v1] \n]\n
30 write_file t3 [join [string trim $v2] \n]\n
31 fossil test-3-way-merge t1 t2 t3 t4
32 set x [read_file t4]
33 regsub -all {<<<<<<< BEGIN MERGE CONFLICT} $x {>} x
34 regsub -all {============================} $x {=} x
35 regsub -all {>>>>>>> END MERGE CONFLICT} $x {<} x
36 set x [split [string trim $x] \n]
37 set result [string trim $result]
38 if {$x!=$result} {
39 protOut " Expected \[$result\]"
40 protOut " Got \[$x\]"
41 test merge3-$testid 0
42 } else {
43 test merge3-$testid 1
44 }
45 }
46
M test/merge4.test
+8 -8
--- test/merge4.test
+++ test/merge4.test
@@ -29,29 +29,29 @@
2929
 write_file t2 [join [string trim $v1] \n]\n
3030
 write_file t3 [join [string trim $v2] \n]\n
3131
 fossil test-3-way-merge t1 t2 t3 t4
3232
 fossil test-3-way-merge t1 t3 t2 t5
3333
 set x [read_file t4]
34
- regsub -all {>>>>>>> BEGIN MERGE CONFLICT} $x {>} x
34
+ regsub -all {<<<<<<< BEGIN MERGE CONFLICT} $x {>} x
3535
 regsub -all {============================} $x {=} x
36
- regsub -all {<<<<<<< END MERGE CONFLICT} $x {<} x
36
+ regsub -all {>>>>>>> END MERGE CONFLICT} $x {<} x
3737
 set x [split [string trim $x] \n]
3838
 set y [read_file t5]
39
- regsub -all {>>>>>>> BEGIN MERGE CONFLICT} $y {>} y
39
+ regsub -all {<<<<<<< BEGIN MERGE CONFLICT} $y {>} y
4040
 regsub -all {============================} $y {=} y
41
- regsub -all {<<<<<<< END MERGE CONFLICT} $y {<} y
41
+ regsub -all {>>>>>>> END MERGE CONFLICT} $y {<} y
4242
 set y [split [string trim $y] \n]
4343
 set result1 [string trim $result1]
4444
 if {$x!=$result1} {
45
- puts " Expected \[$result1\]"
46
- puts " Got \[$x\]"
45
+ protOut " Expected \[$result1\]"
46
+ protOut " Got \[$x\]"
4747
 test merge3-$testid 0
4848
 } else {
4949
 set result2 [string trim $result2]
5050
 if {$y!=$result2} {
51
- puts " Expected \[$result2\]"
52
- puts " Got \[$y\]"
51
+ protOut " Expected \[$result2\]"
52
+ protOut " Got \[$y\]"
5353
 test merge3-$testid 0
5454
 } else {
5555
 test merge3-$testid 1
5656
 }
5757
 }
5858
--- test/merge4.test
+++ test/merge4.test
@@ -29,29 +29,29 @@
29 write_file t2 [join [string trim $v1] \n]\n
30 write_file t3 [join [string trim $v2] \n]\n
31 fossil test-3-way-merge t1 t2 t3 t4
32 fossil test-3-way-merge t1 t3 t2 t5
33 set x [read_file t4]
34 regsub -all {>>>>>>> BEGIN MERGE CONFLICT} $x {>} x
35 regsub -all {============================} $x {=} x
36 regsub -all {<<<<<<< END MERGE CONFLICT} $x {<} x
37 set x [split [string trim $x] \n]
38 set y [read_file t5]
39 regsub -all {>>>>>>> BEGIN MERGE CONFLICT} $y {>} y
40 regsub -all {============================} $y {=} y
41 regsub -all {<<<<<<< END MERGE CONFLICT} $y {<} y
42 set y [split [string trim $y] \n]
43 set result1 [string trim $result1]
44 if {$x!=$result1} {
45 puts " Expected \[$result1\]"
46 puts " Got \[$x\]"
47 test merge3-$testid 0
48 } else {
49 set result2 [string trim $result2]
50 if {$y!=$result2} {
51 puts " Expected \[$result2\]"
52 puts " Got \[$y\]"
53 test merge3-$testid 0
54 } else {
55 test merge3-$testid 1
56 }
57 }
58
--- test/merge4.test
+++ test/merge4.test
@@ -29,29 +29,29 @@
29 write_file t2 [join [string trim $v1] \n]\n
30 write_file t3 [join [string trim $v2] \n]\n
31 fossil test-3-way-merge t1 t2 t3 t4
32 fossil test-3-way-merge t1 t3 t2 t5
33 set x [read_file t4]
34 regsub -all {<<<<<<< BEGIN MERGE CONFLICT} $x {>} x
35 regsub -all {============================} $x {=} x
36 regsub -all {>>>>>>> END MERGE CONFLICT} $x {<} x
37 set x [split [string trim $x] \n]
38 set y [read_file t5]
39 regsub -all {<<<<<<< BEGIN MERGE CONFLICT} $y {>} y
40 regsub -all {============================} $y {=} y
41 regsub -all {>>>>>>> END MERGE CONFLICT} $y {<} y
42 set y [split [string trim $y] \n]
43 set result1 [string trim $result1]
44 if {$x!=$result1} {
45 protOut " Expected \[$result1\]"
46 protOut " Got \[$x\]"
47 test merge3-$testid 0
48 } else {
49 set result2 [string trim $result2]
50 if {$y!=$result2} {
51 protOut " Expected \[$result2\]"
52 protOut " Got \[$y\]"
53 test merge3-$testid 0
54 } else {
55 test merge3-$testid 1
56 }
57 }
58
M test/tester.tcl
+38 -5
--- test/tester.tcl
+++ test/tester.tcl
@@ -38,27 +38,59 @@
3838
 set HALT 1
3939
 set argv [lreplace $argv $i $i]
4040
 } else {
4141
 set HALT 0
4242
 }
43
+
44
+set i [lsearch $argv -prot]
45
+if {$i>=0} {
46
+ set PROT 1
47
+ set argv [lreplace $argv $i $i]
48
+} else {
49
+ set PROT 0
50
+}
4351
4452
 if {[llength $argv]==0} {
4553
 foreach f [lsort [glob $testdir/*.test]] {
4654
 set base [file root [file tail $f]]
4755
 lappend argv $base
4856
 }
4957
 }
58
+
59
+# start protocol
60
+#
61
+proc protInit {cmd} {
62
+ if {$::PROT} {
63
+ set out [open "prot" w]
64
+ fconfigure $out -translation platform
65
+ puts $out "starting tests with:$cmd"
66
+ close $out
67
+ }
68
+}
69
+
70
+# write protocol
71
+#
72
+proc protOut {msg} {
73
+ puts "$msg"
74
+ if {$::PROT} {
75
+ set out [open "prot" a]
76
+ fconfigure $out -translation platform
77
+ puts $out "$msg"
78
+ close $out
79
+ }
80
+}
5081
5182
 # Run the fossil program
5283
 #
5384
 proc fossil {args} {
5485
 global fossilexe
5586
 set cmd $fossilexe
5687
 foreach a $args {
5788
 lappend cmd $a
5889
 }
59
- puts $cmd
90
+ protOut $cmd
91
+
6092
 flush stdout
6193
 set rc [catch {eval exec $cmd} result]
6294
 global RESULT CODE
6395
 set CODE $rc
6496
 set RESULT $result
@@ -100,13 +132,13 @@
100132
 #
101133
 proc test {name expr} {
102134
 global bad_test
103135
 set r [uplevel 1 [list expr $expr]]
104136
 if {$r} {
105
- puts "test $name OK"
137
+ protOut "test $name OK"
106138
 } else {
107
- puts "test $name FAILED!"
139
+ protOut "test $name FAILED!"
108140
 lappend bad_test $name
109141
 if {$::HALT} exit
110142
 }
111143
 }
112144
 set bad_test {}
@@ -167,10 +199,11 @@
167199
 append out \n$line
168200
 }
169201
 return [string range $out 1 end]
170202
 }
171203
204
+protInit $fossilexe
172205
 foreach testfile $argv {
173
- puts "***** $testfile ******"
206
+ protOut "***** $testfile ******"
174207
 source $testdir/$testfile.test
175208
 }
176
-puts "[llength $bad_test] errors: $bad_test"
209
+protOut "[llength $bad_test] errors: $bad_test"
177210
--- test/tester.tcl
+++ test/tester.tcl
@@ -38,27 +38,59 @@
38 set HALT 1
39 set argv [lreplace $argv $i $i]
40 } else {
41 set HALT 0
42 }
 
 
 
 
 
 
 
 
43
44 if {[llength $argv]==0} {
45 foreach f [lsort [glob $testdir/*.test]] {
46 set base [file root [file tail $f]]
47 lappend argv $base
48 }
49 }
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
50
51 # Run the fossil program
52 #
53 proc fossil {args} {
54 global fossilexe
55 set cmd $fossilexe
56 foreach a $args {
57 lappend cmd $a
58 }
59 puts $cmd
 
60 flush stdout
61 set rc [catch {eval exec $cmd} result]
62 global RESULT CODE
63 set CODE $rc
64 set RESULT $result
@@ -100,13 +132,13 @@
100 #
101 proc test {name expr} {
102 global bad_test
103 set r [uplevel 1 [list expr $expr]]
104 if {$r} {
105 puts "test $name OK"
106 } else {
107 puts "test $name FAILED!"
108 lappend bad_test $name
109 if {$::HALT} exit
110 }
111 }
112 set bad_test {}
@@ -167,10 +199,11 @@
167 append out \n$line
168 }
169 return [string range $out 1 end]
170 }
171
 
172 foreach testfile $argv {
173 puts "***** $testfile ******"
174 source $testdir/$testfile.test
175 }
176 puts "[llength $bad_test] errors: $bad_test"
177
--- test/tester.tcl
+++ test/tester.tcl
@@ -38,27 +38,59 @@
38 set HALT 1
39 set argv [lreplace $argv $i $i]
40 } else {
41 set HALT 0
42 }
43
44 set i [lsearch $argv -prot]
45 if {$i>=0} {
46 set PROT 1
47 set argv [lreplace $argv $i $i]
48 } else {
49 set PROT 0
50 }
51
52 if {[llength $argv]==0} {
53 foreach f [lsort [glob $testdir/*.test]] {
54 set base [file root [file tail $f]]
55 lappend argv $base
56 }
57 }
58
59 # start protocol
60 #
61 proc protInit {cmd} {
62 if {$::PROT} {
63 set out [open "prot" w]
64 fconfigure $out -translation platform
65 puts $out "starting tests with:$cmd"
66 close $out
67 }
68 }
69
70 # write protocol
71 #
72 proc protOut {msg} {
73 puts "$msg"
74 if {$::PROT} {
75 set out [open "prot" a]
76 fconfigure $out -translation platform
77 puts $out "$msg"
78 close $out
79 }
80 }
81
82 # Run the fossil program
83 #
84 proc fossil {args} {
85 global fossilexe
86 set cmd $fossilexe
87 foreach a $args {
88 lappend cmd $a
89 }
90 protOut $cmd
91
92 flush stdout
93 set rc [catch {eval exec $cmd} result]
94 global RESULT CODE
95 set CODE $rc
96 set RESULT $result
@@ -100,13 +132,13 @@
132 #
133 proc test {name expr} {
134 global bad_test
135 set r [uplevel 1 [list expr $expr]]
136 if {$r} {
137 protOut "test $name OK"
138 } else {
139 protOut "test $name FAILED!"
140 lappend bad_test $name
141 if {$::HALT} exit
142 }
143 }
144 set bad_test {}
@@ -167,10 +199,11 @@
199 append out \n$line
200 }
201 return [string range $out 1 end]
202 }
203
204 protInit $fossilexe
205 foreach testfile $argv {
206 protOut "***** $testfile ******"
207 source $testdir/$testfile.test
208 }
209 protOut "[llength $bad_test] errors: $bad_test"
210

Keyboard Shortcuts

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