Fossil SCM

Add '-quiet' command line option to the test suite.

mistachkin 2016-01-06 17:18 trunk
Commit c2e42166ef4504c0cd3d49ab34fe5a63d9b33c5b
Parent 52ee83c72945446…
1 file changed +22 -9
~ test/tester.tcl
M test/tester.tcl
+22 -9
--- test/tester.tcl
+++ test/tester.tcl
@@ -49,10 +49,18 @@
4949
 set VERBOSE 1
5050
 set argv [lreplace $argv $i $i]
5151
 } else {
5252
 set VERBOSE 0
5353
 }
54
+
55
+set i [lsearch $argv -quiet]
56
+if {$i>=0} {
57
+ set QUIET 1
58
+ set argv [lreplace $argv $i $i]
59
+} else {
60
+ set QUIET 0
61
+}
5462
5563
 if {[llength $argv]==0} {
5664
 foreach f [lsort [glob $testdir/*.test]] {
5765
 set base [file root [file tail $f]]
5866
 lappend argv $base
@@ -70,12 +78,14 @@
7078
 }
7179
 }
7280
7381
 # write protocol
7482
 #
75
-proc protOut {msg} {
76
- puts stdout $msg
83
+proc protOut {msg {noQuiet 0}} {
84
+ if {$noQuiet || !$::QUIET} {
85
+ puts stdout $msg
86
+ }
7787
 if {$::PROT} {
7888
 set out [open [file join $::testrundir prot] a]
7989
 fconfigure $out -translation platform
8090
 puts $out $msg
8191
 close $out
@@ -119,11 +129,11 @@
119129
 set rc [catch {eval exec $cmd} result]
120130
 }
121131
 global RESULT CODE
122132
 set CODE $rc
123133
 if {$rc} {
124
- protOut "ERROR: $result"
134
+ protOut "ERROR: $result" 1
125135
 } elseif {$::VERBOSE} {
126136
 protOut "RESULT: $result"
127137
 }
128138
 set RESULT $result
129139
 }
@@ -200,12 +210,12 @@
200210
 set expected [normalize_status_list $expected]
201211
 set result [normalize_status_list $result]
202212
 if {$result eq $expected} {
203213
 test $name 1
204214
 } else {
205
- protOut " Expected:\n [join $expected "\n "]"
206
- protOut " Got:\n [join $result "\n "]"
215
+ protOut " Expected:\n [join $expected "\n "]" 1
216
+ protOut " Got:\n [join $result "\n "]" 1
207217
 test $name 0
208218
 }
209219
 }
210220
211221
 # Append all arguments into a single value and then returns it.
@@ -275,17 +285,18 @@
275285
276286
 # Perform a test
277287
 #
278288
 set test_count 0
279289
 proc test {name expr} {
280
- global bad_test test_count
290
+ global bad_test test_count RESULT
281291
 incr test_count
282292
 set r [uplevel 1 [list expr $expr]]
283293
 if {$r} {
284294
 protOut "test $name OK"
285295
 } else {
286
- protOut "test $name FAILED!"
296
+ protOut "test $name FAILED!" 1
297
+ if {$::QUIET} {protOut "RESULT: $RESULT" 1}
287298
 lappend bad_test $name
288299
 if {$::HALT} exit
289300
 }
290301
 }
291302
 set bad_test {}
@@ -439,9 +450,11 @@
439450
 source $testdir/$testfile.test
440451
 protOut "***** End of $testfile: [llength $bad_test] errors so far ******"
441452
 cd $origwd
442453
 }
443454
 set nErr [llength $bad_test]
444
-protOut "***** Final result: $nErr errors out of $test_count tests"
455
+if {$nErr>0 || !$::QUIET} {
456
+ protOut "***** Final result: $nErr errors out of $test_count tests" 1
457
+}
445458
 if {$nErr>0} {
446
- protOut "***** Failures: $bad_test"
459
+ protOut "***** Failures: $bad_test" 1
447460
 }
448461
--- test/tester.tcl
+++ test/tester.tcl
@@ -49,10 +49,18 @@
49 set VERBOSE 1
50 set argv [lreplace $argv $i $i]
51 } else {
52 set VERBOSE 0
53 }
 
 
 
 
 
 
 
 
54
55 if {[llength $argv]==0} {
56 foreach f [lsort [glob $testdir/*.test]] {
57 set base [file root [file tail $f]]
58 lappend argv $base
@@ -70,12 +78,14 @@
70 }
71 }
72
73 # write protocol
74 #
75 proc protOut {msg} {
76 puts stdout $msg
 
 
77 if {$::PROT} {
78 set out [open [file join $::testrundir prot] a]
79 fconfigure $out -translation platform
80 puts $out $msg
81 close $out
@@ -119,11 +129,11 @@
119 set rc [catch {eval exec $cmd} result]
120 }
121 global RESULT CODE
122 set CODE $rc
123 if {$rc} {
124 protOut "ERROR: $result"
125 } elseif {$::VERBOSE} {
126 protOut "RESULT: $result"
127 }
128 set RESULT $result
129 }
@@ -200,12 +210,12 @@
200 set expected [normalize_status_list $expected]
201 set result [normalize_status_list $result]
202 if {$result eq $expected} {
203 test $name 1
204 } else {
205 protOut " Expected:\n [join $expected "\n "]"
206 protOut " Got:\n [join $result "\n "]"
207 test $name 0
208 }
209 }
210
211 # Append all arguments into a single value and then returns it.
@@ -275,17 +285,18 @@
275
276 # Perform a test
277 #
278 set test_count 0
279 proc test {name expr} {
280 global bad_test test_count
281 incr test_count
282 set r [uplevel 1 [list expr $expr]]
283 if {$r} {
284 protOut "test $name OK"
285 } else {
286 protOut "test $name FAILED!"
 
287 lappend bad_test $name
288 if {$::HALT} exit
289 }
290 }
291 set bad_test {}
@@ -439,9 +450,11 @@
439 source $testdir/$testfile.test
440 protOut "***** End of $testfile: [llength $bad_test] errors so far ******"
441 cd $origwd
442 }
443 set nErr [llength $bad_test]
444 protOut "***** Final result: $nErr errors out of $test_count tests"
 
 
445 if {$nErr>0} {
446 protOut "***** Failures: $bad_test"
447 }
448
--- test/tester.tcl
+++ test/tester.tcl
@@ -49,10 +49,18 @@
49 set VERBOSE 1
50 set argv [lreplace $argv $i $i]
51 } else {
52 set VERBOSE 0
53 }
54
55 set i [lsearch $argv -quiet]
56 if {$i>=0} {
57 set QUIET 1
58 set argv [lreplace $argv $i $i]
59 } else {
60 set QUIET 0
61 }
62
63 if {[llength $argv]==0} {
64 foreach f [lsort [glob $testdir/*.test]] {
65 set base [file root [file tail $f]]
66 lappend argv $base
@@ -70,12 +78,14 @@
78 }
79 }
80
81 # write protocol
82 #
83 proc protOut {msg {noQuiet 0}} {
84 if {$noQuiet || !$::QUIET} {
85 puts stdout $msg
86 }
87 if {$::PROT} {
88 set out [open [file join $::testrundir prot] a]
89 fconfigure $out -translation platform
90 puts $out $msg
91 close $out
@@ -119,11 +129,11 @@
129 set rc [catch {eval exec $cmd} result]
130 }
131 global RESULT CODE
132 set CODE $rc
133 if {$rc} {
134 protOut "ERROR: $result" 1
135 } elseif {$::VERBOSE} {
136 protOut "RESULT: $result"
137 }
138 set RESULT $result
139 }
@@ -200,12 +210,12 @@
210 set expected [normalize_status_list $expected]
211 set result [normalize_status_list $result]
212 if {$result eq $expected} {
213 test $name 1
214 } else {
215 protOut " Expected:\n [join $expected "\n "]" 1
216 protOut " Got:\n [join $result "\n "]" 1
217 test $name 0
218 }
219 }
220
221 # Append all arguments into a single value and then returns it.
@@ -275,17 +285,18 @@
285
286 # Perform a test
287 #
288 set test_count 0
289 proc test {name expr} {
290 global bad_test test_count RESULT
291 incr test_count
292 set r [uplevel 1 [list expr $expr]]
293 if {$r} {
294 protOut "test $name OK"
295 } else {
296 protOut "test $name FAILED!" 1
297 if {$::QUIET} {protOut "RESULT: $RESULT" 1}
298 lappend bad_test $name
299 if {$::HALT} exit
300 }
301 }
302 set bad_test {}
@@ -439,9 +450,11 @@
450 source $testdir/$testfile.test
451 protOut "***** End of $testfile: [llength $bad_test] errors so far ******"
452 cd $origwd
453 }
454 set nErr [llength $bad_test]
455 if {$nErr>0 || !$::QUIET} {
456 protOut "***** Final result: $nErr errors out of $test_count tests" 1
457 }
458 if {$nErr>0} {
459 protOut "***** Failures: $bad_test" 1
460 }
461

Keyboard Shortcuts

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