testsuite/report-card.all/passes.exp

   1 # Copyright (C) 2018 Free Software Foundation, Inc.
   2 #
   3 # This file is part of DejaGnu.
   4 #
   5 # DejaGnu is free software; you can redistribute it and/or modify it
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # DejaGnu is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 # General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with DejaGnu; if not, write to the Free Software Foundation,
  17 # Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
  18
  19 # This file was written by Jacob Bachmeyer.
  20
  21 load_lib bohman_ssd.exp
  22
  23 set header_column_names { PASS FAIL ?PASS ?FAIL UNSUP UNRES UNTEST }
  24 set result_column_map {
  25     PASS FAIL { KPASS XPASS } { KFAIL XFAIL }
  26     UNSUPPORTED UNRESOLVED UNTESTED
  27 }
  28
  29 set test_results { PASS FAIL KPASS KFAIL XPASS XFAIL
  30                    UNSUPPORTED UNRESOLVED UNTESTED }
  31
  32 # each entry: { {mode n} { suffix_tag... } { pass... } { { result name }... } }
  33 array unset tuplemap
  34 array set tuplemap {
  35     basic       { {S  3} { a b } { foo bar }
  36         { { PASS pass } { FAIL fail } } }
  37     kxpass      { {S  2} { a b } { foo bar }
  38         { { KPASS kpass } { XPASS xpass } } }
  39     kxfail      { {Sp 2} { a b } { foo bar }
  40         { { KFAIL kfail } { XFAIL xfail } } }
  41     unresult    { {S  2} { a b } { foo bar }
  42         { { UNSUPPORTED unsupported }
  43             { UNRESOLVED unresolved } { UNTESTED untested } } }
  44 }
  45
  46 # Given: TUPLES: { { result ... }... }, PASSES: { pass... }
  47 # Return: Cartesian product TUPLES x PASSES: { { result pass ... }... }
  48 proc build_tuple_list { tuples passes } {
  49     set result [list]
  50     foreach cell $tuples {
  51         foreach pass $passes {
  52             lappend result [linsert $cell 1 $pass]
  53         }
  54     }
  55     return $result
  56 }
  57
  58 # Given: TUPLES: { { result pass name }... }, MODE: S | Sp, N
  59 # Return: { { result pass name count }... } where COUNT is from an SSD-set
  60 proc annotate_tuple_list { tuples mode n } {
  61     set m [llength $tuples]
  62     set ssd [switch -- $mode {
  63         S  { ::math_utils::Bohman_SSD::S  $n $m }
  64         Sp { ::math_utils::Bohman_SSD::Sp $n $m }
  65     }]
  66     set result [list]
  67     foreach cell $tuples ssdterm $ssd {
  68         lappend result [linsert $cell end $ssdterm]
  69     }
  70     return $result
  71 }
  72
  73 # Given: TUPLES: { { result pass name count }... }; (RESULT,PASS) not unique
  74 # Return: { { result pass expected_total }... } where (RESULT,PASS) is unique
  75 proc compute_expected_pass_totals { tuples } {
  76     foreach cell $tuples {  set count([lrange $cell 0 1]) 0 }
  77     foreach cell $tuples { incr count([lrange $cell 0 1]) [lindex $cell 3] }
  78     set result [list]
  79     foreach name [lsort [array names count]] {
  80         lappend result [concat $name $count($name)]
  81     }
  82     return $result
  83 }
  84
  85 # Given: TUPLES: { { result pass name count }... }; (RESULT,PASS) not unique
  86 # Return: { { result expected_grand_total }... }
  87 proc compute_expected_grand_totals { tuples } {
  88     foreach cell $tuples {  set count([lindex $cell 0]) 0 }
  89     foreach cell $tuples { incr count([lindex $cell 0]) [lindex $cell 3] }
  90     set result [list]
  91     foreach name [lsort [array names count]] {
  92         lappend result [list $name $count($name)]
  93     }
  94     return $result
  95 }
  96
  97 # Given: TUPLES: { { result pass ... }... } where (RESULT,PASS) repeats later
  98 # Return: { { { result pass ... }... }... }; (RESULT,PASS) unique per sublist
  99 proc split_tuple_list { tuples } {
 100     set result [list]
 101     set sublist [list]
 102     foreach cell $tuples {
 103         if { [info exists seen([lrange $cell 0 1])] } {
 104             # split here
 105             lappend result $sublist
 106             set sublist [list]
 107             array unset seen
 108         }
 109         lappend sublist $cell
 110         set seen([lrange $cell 0 1]) 1
 111     }
 112     lappend result $sublist
 113     return $result
 114 }
 115
 116 # TUPLES is: { { result pass name count }... }
 117 proc write_file { basename tuples } {
 118     set fd [open [testsuite file -object -test passes ${basename}.sum] w]
 119     set pass {}
 120     foreach cell [lsort -index 1 $tuples] {
 121         if { $pass ne [lindex $cell 1] } {
 122             puts $fd "Running pass `[lindex $cell 1]' ..."
 123             set pass [lindex $cell 1]
 124         }
 125         for { set i 1 } { $i <= [lindex $cell 3] } { incr i } {
 126             puts $fd "[lindex $cell 0]: [lindex $cell 1]:\
 127                         [lindex $cell 2] test ${i}/[lindex $cell 3]"
 128         }
 129     }
 130     close $fd
 131 }
 132
 133 proc run_multipass_output_test { filetag } {
 134     global LAUNCHER
 135     global header_column_names
 136     global result_column_map
 137     global test_results
 138     global tuplemap
 139
 140     set ssdpar  [lindex $tuplemap($filetag) 0]
 141     set tags    [lindex $tuplemap($filetag) 1]
 142     set passes  [lindex $tuplemap($filetag) 2]
 143     set results {}
 144     foreach dummy $tags { lappend results [lindex $tuplemap($filetag) 3] }
 145     set results [join $results]
 146
 147     # initialize totals arrays to zero
 148     foreach result $test_results { set have_grand_totals($result) 0 }
 149     array set want_grand_totals [array get have_grand_totals]
 150     foreach cell [build_tuple_list $test_results $passes] {
 151         set have_pass_totals([join [lrange $cell 0 1] ","]) 0
 152     }
 153     array set want_pass_totals [array get have_pass_totals]
 154
 155     # get the test list
 156     set list [build_tuple_list $results $passes]
 157     set list [annotate_tuple_list $list [lindex $ssdpar 0] [lindex $ssdpar 1]]
 158
 159     # compute expected totals
 160     #  note that this only fills non-zero array positions
 161     foreach cell [compute_expected_pass_totals $list] {
 162         set want_pass_totals([join [lrange $cell 0 1] ","]) [lindex $cell 2]
 163     }
 164     array set want_grand_totals [join [compute_expected_grand_totals $list]]
 165
 166     # write the test data files and store expected per-file counts
 167     foreach tag $tags fileset [split_tuple_list $list] {
 168         # write test file
 169         write_file "${filetag}-${tag}" $fileset
 170         # initialize test results for this file
 171         foreach result $test_results {
 172             foreach pass $passes {
 173                 set want_file_counts(${filetag}-${tag},$result,$pass) 0
 174                 set have_file_counts(${filetag}-${tag},$result,$pass) 0
 175             }
 176         }
 177         # store expected results for this file
 178         foreach cell $fileset {
 179             set want_file_counts(${filetag}-${tag},[join [lrange $cell 0 1] \
 180                                                         ","]) [lindex $cell 3]
 181         }
 182     }
 183
 184     # run the dejagnu-report-card tool
 185     set separator_count 0
 186     spawn /bin/sh -c \
 187         "cd [testsuite file -object -test passes]\
 188          && exec $LAUNCHER report-card ${filetag}-*.sum"
 189
 190     # skip header
 191     expect {
 192         -re {^[[:space:]]+_+[\r\n]+} { exp_continue }
 193         -re {^[[:space:]]+/([^\r\n]*)[\r\n]+} { exp_continue }
 194         -re {^[[:space:]]+\|-+[\r\n]+} { incr separator_count }
 195     }
 196
 197     # read individual file lines
 198     set re_file_row {^[[:space:]]*}
 199     append re_file_row {(} $filetag {-[[:alpha:]]+)[[:space:]]+}
 200     append re_file_row {/[[:space:]]+([[:alpha:]]+)[[:space:]]+\|}
 201     append re_file_row {[[:space:]]*([[:digit:][:space:]]+)[\r\n]+}
 202     expect {
 203         -re $re_file_row {
 204             foreach column $result_column_map colname $header_column_names \
 205                 have $expect_out(3,string) {
 206                     set want 0
 207                     foreach rs $column {
 208                         set tmp $expect_out(1,string),$rs,$expect_out(2,string)
 209                         incr want $want_file_counts($tmp)
 210                     }
 211                     if { $have == $want } {
 212                         pass "count $colname\
 213                               for pass $expect_out(2,string)\
 214                               in file $expect_out(1,string)"
 215                     } else {
 216                         fail "count $colname\
 217                               for pass $expect_out(2,string)\
 218                               in file $expect_out(1,string)"
 219                     }
 220                 }
 221             exp_continue
 222         }
 223         -re {^[[:space:]]+\|-+[\r\n]+} { incr separator_count }
 224     }
 225
 226     # read pass totals lines
 227     set re_pass_row {^[[:space:]]+([[:alpha:]]+)[[:space:]]+\|}
 228     append re_pass_row {[[:space:]]*([[:digit:][:space:]]+)[\r\n]+}
 229     expect {
 230         -re $re_pass_row {
 231             foreach column $result_column_map colname $header_column_names \
 232                 have $expect_out(2,string) {
 233                     set want 0
 234                     foreach rs $column {
 235                         incr want $want_pass_totals($rs,$expect_out(1,string))
 236                     }
 237                     if { $have == $want } {
 238                         pass "total $colname for pass $expect_out(1,string)"
 239                     } else {
 240                         fail "total $colname for pass $expect_out(1,string)"
 241                     }
 242                 }
 243             exp_continue
 244         }
 245         -re {^[[:space:]]+\|-+[\r\n]+} { incr separator_count }
 246     }
 247
 248     # read grand totals line
 249     expect -re {^[[:space:]]+\|[[:space:]]*([[:digit:][:space:]]+)[\r\n]+} {
 250         foreach column $result_column_map colname $header_column_names \
 251             have $expect_out(1,string) {
 252                 set want 0
 253                 foreach rs $column { incr want $want_grand_totals($rs) }
 254                 if { $have == $want } {
 255                     pass "grand total $colname"
 256                 } else {
 257                     fail "grand total $colname"
 258                 }
 259             }
 260     }
 261
 262     # skip the footer
 263     expect -re {.+} { exp_continue }
 264
 265     if { $separator_count == 3 } {
 266         pass "expected separator lines"
 267     } else {
 268         fail "expected separator lines"
 269     }
 270 }
 271
 272 foreach filetag [lsort [array names tuplemap]] {
 273     run_multipass_output_test $filetag
 274 }
 275
 276 #EOF