wvtestmeter

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