gcc/testsuite/lib/scandump.exp

   1 # Copyright (C) 2000-2020 Free Software Foundation, Inc.
   2
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 3 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with GCC; see the file COPYING3.  If not see
  15 # <http://www.gnu.org/licenses/>.
  16
  17 # Various utilities for scanning dump output, used by gcc-dg.exp and
  18 # g++-dg.exp.
  19 #
  20 # This is largely borrowed from scanasm.exp.
  21
  22 # Extract the constant part of the dump file suffix from the regexp.
  23 # Argument 0 is the regular expression.
  24 proc dump-suffix { arg } {
  25     set idx [expr [string first "." $arg] + 1]
  26     return [string range $arg $idx end]
  27 }
  28
  29 # Construct the dumpbase.
  30 # Argument 0 is the src file
  31 # Argument 1 is the dump base suffix
  32 proc dump-base { args } {
  33     set src [lindex $args 0]
  34     set dumpbase_suf [lindex $args 1]
  35     # The dump basename may vary depending on the output name, on
  36     # whether there are multiple sources.  We use -dumpbase "" in
  37     # gcc-defs to base compilation dumps only on the source basename.
  38     set dumpbase $src
  39     if { [string length $dumpbase_suf] != 0 } {
  40         regsub {[.][^.]*$} $src $dumpbase_suf dumpbase
  41     }
  42     return $dumpbase
  43 }
  44
  45 # Utility for scanning compiler result, invoked via dg-final.
  46 # Call pass if pattern is present, otherwise fail.
  47 #
  48 # Argument 0 is the type of dump we are searching (rtl, tree, ipa)
  49 # Argument 1 is the regexp to match.
  50 # Argument 2 is the suffix for the dump file
  51 # Argument 3 is the suffix of the dump base
  52 # Argument 4 handles expected failures and the like
  53 proc scan-dump { args } {
  54
  55     if { [llength $args] >= 5 } {
  56         switch [dg-process-target [lindex $args 4]] {
  57             "S" { }
  58             "N" { return }
  59             "F" { setup_xfail "*-*-*" }
  60             "P" { }
  61         }
  62     }
  63
  64     set testcase [testname-for-summary]
  65     # The name might include a list of options; extract the file name.
  66     set filename [lindex $testcase 0]
  67
  68     set printable_pattern [make_pattern_printable [lindex $args 1]]
  69     set suf [dump-suffix [lindex $args 2]]
  70     set testname "$testcase scan-[lindex $args 0]-dump $suf \"$printable_pattern\""
  71     set src [file tail $filename]
  72     set dumpbase [dump-base $src [lindex $args 3]]
  73     set output_file "[glob -nocomplain $dumpbase.[lindex $args 2]]"
  74     if { $output_file == "" } {
  75         verbose -log "$testcase: dump file does not exist"
  76         verbose -log "dump file: $dumpbase.$suf"
  77         unresolved "$testname"
  78         return
  79     }
  80
  81     set fd [open $output_file r]
  82     set text [read $fd]
  83     close $fd
  84
  85     if [regexp -- [lindex $args 1] $text] {
  86         pass "$testname"
  87     } else {
  88         fail "$testname"
  89     }
  90 }
  91
  92 # Call pass if pattern is present given number of times, otherwise fail.
  93 # Argument 0 is the type of dump we are searching (rtl, tree, ipa)
  94 # Argument 1 is the regexp to match.
  95 # Argument 2 is number of times the regexp must be found
  96 # Argument 3 is the suffix for the dump file
  97 # Argument 4 is the suffix of the dump base
  98 # Argument 5 handles expected failures and the like
  99 proc scan-dump-times { args } {
 100
 101     if { [llength $args] >= 6 } {
 102         switch [dg-process-target [lindex $args 5]] {
 103             "S" { }
 104             "N" { return }
 105             "F" { setup_xfail "*-*-*" }
 106             "P" { }
 107         }
 108     }
 109
 110     set testcase [testname-for-summary]
 111     # The name might include a list of options; extract the file name.
 112     set filename [lindex $testcase 0]
 113     set times [lindex $args 2]
 114     set suf [dump-suffix [lindex $args 3]]
 115     set printable_pattern [make_pattern_printable [lindex $args 1]]
 116     set testname "$testcase scan-[lindex $args 0]-dump-times $suf \"$printable_pattern\" [lindex $args 2]"
 117     set src [file tail $filename]
 118     set dumpbase [dump-base $src [lindex $args 4]]
 119     set output_file "[glob -nocomplain $dumpbase.[lindex $args 3]]"
 120     if { $output_file == "" } {
 121         verbose -log "$testcase: dump file does not exist"
 122         unresolved "$testname"
 123         return
 124     }
 125
 126     set fd [open $output_file r]
 127     set text [read $fd]
 128     close $fd
 129
 130     set result_count [llength [regexp -inline -all -- [lindex $args 1] $text]]
 131     if {$result_count == $times} {
 132         pass "$testname"
 133     } else {
 134         verbose -log "$testcase: pattern found $result_count times"
 135         fail "$testname"
 136     }
 137 }
 138
 139 # Call pass if pattern is not present, otherwise fail.
 140 #
 141 # Argument 0 is the type of dump we are searching (rtl, tree, ipa)
 142 # Argument 1 is the regexp to match.
 143 # Argument 2 is the suffix for the dump file
 144 # Argument 3 is the suffix of the dump base
 145 # Argument 4 handles expected failures and the like
 146 proc scan-dump-not { args } {
 147
 148     if { [llength $args] >= 5 } {
 149         switch [dg-process-target [lindex $args 4]] {
 150             "S" { }
 151             "N" { return }
 152             "F" { setup_xfail "*-*-*" }
 153             "P" { }
 154         }
 155     }
 156
 157     set testcase [testname-for-summary]
 158     # The name might include a list of options; extract the file name.
 159     set filename [lindex $testcase 0]
 160     set printable_pattern [make_pattern_printable [lindex $args 1]]
 161     set suf [dump-suffix [lindex $args 2]]
 162     set testname "$testcase scan-[lindex $args 0]-dump-not $suf \"$printable_pattern\""
 163     set src [file tail $filename]
 164     set dumpbase [dump-base $src [lindex $args 3]]
 165     set output_file "[glob -nocomplain $dumpbase.[lindex $args 2]]"
 166     if { $output_file == "" } {
 167         verbose -log "$testcase: dump file does not exist"
 168         unresolved "$testname"
 169         return
 170     }
 171
 172     set fd [open $output_file r]
 173     set text [read $fd]
 174     close $fd
 175
 176     if ![regexp -- [lindex $args 1] $text] {
 177         pass "$testname"
 178     } else {
 179         fail "$testname"
 180     }
 181 }
 182
 183 # Utility for scanning demangled compiler result, invoked via dg-final.
 184 # Call pass if pattern is present, otherwise fail.
 185 #
 186 # Argument 0 is the type of dump we are searching (rtl, tree, ipa)
 187 # Argument 1 is the regexp to match.
 188 # Argument 2 is the suffix for the dump file
 189 # Argument 3 is the suffix of the dump base
 190 # Argument 4 handles expected failures and the like
 191 proc scan-dump-dem { args } {
 192     global cxxfilt
 193     global base_dir
 194
 195     if { [llength $args] >= 5 } {
 196         switch [dg-process-target [lindex $args 4]] {
 197             "S" { }
 198             "N" { return }
 199             "F" { setup_xfail "*-*-*" }
 200             "P" { }
 201         }
 202     }
 203
 204     # Find c++filt like we find g++ in g++.exp.
 205     if ![info exists cxxfilt]  {
 206         set cxxfilt [findfile $base_dir/../../../binutils/cxxfilt \
 207                      $base_dir/../../../binutils/cxxfilt \
 208                      [findfile $base_dir/../../c++filt $base_dir/../../c++filt \
 209                       [findfile $base_dir/c++filt $base_dir/c++filt \
 210                        [transform c++filt]]]]
 211         verbose -log "c++filt is $cxxfilt"
 212     }
 213
 214     set testcase [testname-for-summary]
 215     # The name might include a list of options; extract the file name.
 216     set filename [lindex $testcase 0]
 217     set printable_pattern [make_pattern_printable [lindex $args 1]]
 218     set suf [dump-suffix [lindex $args 2]]
 219     set testname "$testcase scan-[lindex $args 0]-dump-dem $suf \"$printable_pattern\""
 220     set src [file tail $filename]
 221     set dumpbase [dump-base $src [lindex $args 3]]
 222     set output_file "[glob -nocomplain $dumpbase.[lindex $args 2]]"
 223     if { $output_file == "" } {
 224         verbose -log "$testcase: dump file does not exist"
 225         unresolved "$testname"
 226         return
 227     }
 228
 229     set fd [open "| $cxxfilt < $output_file" r]
 230     set text [read $fd]
 231     close $fd
 232
 233     if [regexp -- [lindex $args 1] $text] {
 234         pass "$testname"
 235     } else {
 236         fail "$testname"
 237     }
 238 }
 239
 240 # Call pass if demangled pattern is not present, otherwise fail.
 241 #
 242 # Argument 0 is the type of dump we are searching (rtl, tree, ipa)
 243 # Argument 1 is the regexp to match.
 244 # Argument 2 is the suffix for the dump file
 245 # Argument 3 is the suffix of the dump base
 246 # Argument 4 handles expected failures and the like
 247 proc scan-dump-dem-not { args } {
 248     global cxxfilt
 249     global base_dir
 250
 251     if { [llength $args] >= 5 } {
 252         switch [dg-process-target [lindex $args 4]] {
 253             "S" { }
 254             "N" { return }
 255             "F" { setup_xfail "*-*-*" }
 256             "P" { }
 257         }
 258     }
 259
 260     # Find c++filt like we find g++ in g++.exp.
 261     if ![info exists cxxfilt]  {
 262         set cxxfilt [findfile $base_dir/../../../binutils/cxxfilt \
 263                      $base_dir/../../../binutils/cxxfilt \
 264                      [findfile $base_dir/../../c++filt $base_dir/../../c++filt \
 265                       [findfile $base_dir/c++filt $base_dir/c++filt \
 266                        [transform c++filt]]]]
 267         verbose -log "c++filt is $cxxfilt"
 268     }
 269
 270     set testcase [testname-for-summary]
 271     # The name might include a list of options; extract the file name.
 272     set filename [lindex $testcase 0]
 273     set printable_pattern [make_pattern_printable [lindex $args 1]
 274     set suf [dump-suffix [lindex $args 2]]
 275     set testname "$testcase scan-[lindex $args 0]-dump-dem-not $suf \"$printable_pattern\""
 276     set src [file tail $filename]
 277     set dumpbase [dump-base $src [lindex $args 3]]
 278     set output_file "[glob -nocomplain $dumpbase.[lindex $args 2]]"
 279     if { $output_file == "" } {
 280         verbose -log "$testcase: dump file does not exist"
 281         unresolved "$testname"
 282         return
 283     }
 284
 285     set fd [open "| $cxxfilt < $output_file" r]
 286     set text [read $fd]
 287     close $fd
 288
 289     if ![regexp -- [lindex $args 1] $text] {
 290         pass "$testname"
 291     } else {
 292         fail "$testname"
 293     }
 294 }