File: mtreview

package info (click to toggle)
modules 5.6.0-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 22,996 kB
  • sloc: exp: 79,667; sh: 6,142; tcl: 5,895; makefile: 1,478; ansic: 474; python: 272; csh: 202; perl: 47; ruby: 44; lisp: 13
file content (210 lines) | stat: -rwxr-xr-x 6,222 bytes parent folder | download | duplicates (3)
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
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
#!/usr/bin/env tclsh
#
# MTREVIEW, review test suite log file
# Copyright (C) 2019-2022 Xavier Delaruelle
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

##########################################################################

proc reportUsage {} {
   puts "Usage: $::argv0 \[options\] testlogfile

Review test suite log file

Options:
  -h, --help      Show this help message and exit

Examples:
   $::argv0 modules.log
   $::argv0 install.log
   $::argv0 lint.log"
}

proc sgr {sgrcode str} {
   return "\033\[${sgrcode}m$str\033\[0m"
}

proc reportError {str} {
   puts "[sgr {1;31} ERROR]: $str"
}

proc diffWithIcdiff {} {
   if {![info exists ::diff_with_icdiff]} {
      # use local installation of icdiff, check it operates correctly
      set ::diff_with_icdiff [expr {[auto_execok ./icdiff] ne\
         {} && ![catch {exec ./icdiff --version}]}]
   }
   return $::diff_with_icdiff
}

proc diffWithDiff {} {
   if {![info exists ::diff_with_diff]} {
      set ::diff_with_diff [expr {[auto_execok diff] ne {}}]
   }
   return $::diff_with_diff
}

proc getDiffCommand {} {
   # preferably use icdiff if possible
   if {[diffWithIcdiff]} {
      set cmdlist [list ./icdiff --no-headers]
      # force term size on the different CI environments
      if {[info exists ::env(GITHUB_ACTIONS)]} {
         lappend cmdlist --cols=170
      } elseif {[info exists ::env(CIRRUS_CI)]} {
         lappend cmdlist --cols=150
      }
   } else {
      set cmdlist [list diff -u]
      if {![catch {exec diff --color=auto /dev/null /dev/null}]} {
         lappend cmdlist --color=auto
      }
   }
   return $cmdlist
}

# parse arguments
set hintmsg "\n  Try '$argv0 --help' for more information."
if {$argc != 1} {
   reportError "Unexpected number of arguments$hintmsg"
   exit 1
}
set arg [lindex $argv 0]
switch -glob -- $arg {
   -h - --help {
      reportUsage
      exit 0
   }
   -* {
      reportError "Invalid option '$arg'$hintmsg"
      exit 1
   }
   default {
      set logfile $arg
   }
}

set fid [open $logfile r]

set state {}
while {[gets $fid line] >= 0} {
   switch -- $state {
      recres {
         ##nagelfar ignore Unknown variable
         if {$res ne {}} {
            append res \n
         } else {
            # trim first line
            set line [string range $line [string first ' $line] end]
         }
         append res $line
         # end of obtained output?
         if {[string range $line end-2 end] eq {'#>}} {
            set state recexp
            # clean content
            set res [string range $res 1 end-3]
         }
      }
      recexp {
         ##nagelfar ignore Unknown variable
         if {$exp ne {}} {
            append exp \n
         } else {
            # trim first line
            set line [string range $line [string first ' $line] end]
         }
         append exp $line
         # end of expected output?
         if {[string range $line end-2 end] eq {'#>}} {
            # clean expecting content from regexp special char escaping
            set trimstart 1
            set trimend 3
            if {[string index $exp 1] eq {^}} {
               incr trimstart
            }
            if {[string index $exp end-3] eq {$}} {
               incr trimend
            }
            set exp [string range $exp $trimstart end-$trimend]
            set exp [regsub -all {\\([\\"'$|{}`* ()!&])} $exp {\1}]

            # diff obtained and expecting output
            if {![info exists externaldiff]} {
               set externaldiff [expr {[diffWithIcdiff] || [diffWithDiff]}]
            }
            # use an external command to diff output
            if {$externaldiff} {
               if {![info exists diffcmdlist]} {
                  set diffcmdlist [getDiffCommand]
               }
               set fidres [open mtreview_res w]
               puts $fidres $res
               close $fidres
               set fidexp [open mtreview_exp w]
               puts $fidexp $exp
               close $fidexp
               if {[set errCode [catch {
                  eval exec >@stdout $diffcmdlist mtreview_exp mtreview_res
               } errMsg]]} {
                  # report trouble of diff command
                  if {[diffWithDiff] && $errCode == 2} {
                     puts "[sgr {1;31} ERROR]: $errMsg"
                  }
               }
               file delete mtreview_exp mtreview_res
            } else {
               puts [sgr {1;31} $exp]
               puts --
               puts [sgr {1;32} $res]
            }

            # clear state to search for next failed test
            set state {}
         }
      }
      sumup {
         if {[string index $line 0] eq "#"} {
            puts $line
         }
      }
      default {
         if {![string compare -length 6 $line {FAIL: }]} {
            if {![info exists failure_found]} {
               set failure_found 1
            }
            set state recres
            set res {}
            set exp {}
            ##nagelfar ignore #3 Unknown variable
            if {![info exists testfile_printed($testfile)]} {
               set testfile_printed($testfile) 1
               puts [sgr {1;34;7} "=== $testfile ==="]
            }
            puts [sgr 7 $line]
         } elseif {![string compare -length 8 $line {Running }]} {
            set testfile [lindex [split $line] 1]
         } elseif {[string match {*Summary ===} $line]} {
            set state sumup
            puts [sgr {1;33;7} {=== test summary ===}]
         }
      }
   }
}

close $fid

exit [info exists failure_found]

# vim:set tabstop=3 shiftwidth=3 expandtab autoindent syntax=tcl: