1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
#!/usr/bin/env wish
wm title . "WvTest Progress"
set pass 0
set fail 0
set total 0
set totalfile ".wvtest-total"
if [file exists $totalfile] {
set f [open $totalfile r]
set xtotal [gets $f]
close $f
} else {
set xtotal 1
}
set font Verdana
set monofont [font create -family Courier]
set monobold [font create -family Courier -weight bold]
label .title -font $font -text "WvTest Progress"
pack .title
frame .f
label .f.t1 -font $font -text "Total:" -font $font
label .f.t2 -font $font -textvariable total
label .f.p1 -font $font -text "Pass:"
label .f.p2 -font $font -textvariable pass
label .f.f1 -font $font -text "Fail:"
label .f.f2 -font $font -textvariable fail
pack .f.t1 .f.t2 .f.p1 .f.p2 .f.f1 .f.f2 -side left
pack .f
frame .f2
label .f2.f1 -font $font -text "Testing:"
label .f2.f2 -font $font -textvariable file
label .f2.f3 -font $font -textvariable sub
pack .f2.f1 .f2.f2 .f2.f3 -side left
pack .f2 -anchor w
scrollbar .s -orient h -width 20
pack .s -fill x -padx 5 -pady 5
frame .b
button .b.logbutton -command showlogs -text "View full log" -relief groove
button .b.closebutton -command {destroy .} -text "Close" -relief groove
pack .b.logbutton .b.closebutton -side left
pack .b -side bottom
frame .l
pack .l -padx 5 -pady 5 -expand on -fill both
scrollbar .l.s -orient v -command {.l.log yview}
pack .l.s -side right -fill y
text .l.log -font $monofont -yscrollcommand {.l.s set}
.l.log tag configure bold -font $monobold -foreground red
pack .l.log -fill both -expand on -side left
set fulllog ""
proc showlogs {} {
global fulllog
.l.log delete 1.0 end
.l.log insert end $fulllog
}
proc addend {text args} {
catch {
.l.log insert end $text $args
.l.log see end
}
}
proc fix_progbar {} {
global total xtotal pass fail fulllog
catch {
# increment progress bar
.s set 0 [expr 1.0*$total/$xtotal]
if {$fail > 0} {
.s config -background red -activebackground red
} else {
.s config -background green -activebackground green
}
}
}
bind . <Key-Escape> {destroy .}
bind . <Key-Return> {destroy .}
focus .l.s
update
fileevent stdin readable {
global fulllog
gets stdin line
if [regexp {^Testing "(.*)" in (.*):$} $line junk sub file] {
addend [format "%-25s %-45s\n" $file $sub]
} elseif [regexp {^! } $line] {
if [regexp {[ \t]([^ \t]+)$} $line junk result] {
# addend "file='$file', result='$result'\n"
if {$result=="ok"} {
incr pass
} else {
incr fail
addend "$line\n" bold
}
incr total
}
}
# puts $line
set fulllog "$fulllog $line\n"
after idle {fix_progbar}
if [eof stdin] {
fileevent stdin readable {}
set done 1
}
}
vwait done
addend "\nAll tests complete: $total total, $pass passes, $fail failures.\n"
catch {
if {$fail > 0} {
.b.closebutton config -background red -relief raised
} else {
set f [open $totalfile w]
puts $f $total
close $f
.b.closebutton config -background green -relief raised
}
}
|
