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     set dumpbase $src
  36     if { [string length $dumpbase_suf] != 0 } {
  37         regsub {[.][^.]*$} $src $dumpbase_suf dumpbase
  38     }
  39     return $dumpbase
  40 }
  41
  42 # Utility for scanning compiler result, invoked via dg-final.
  43 # Call pass if pattern is present, otherwise fail.
  44 #
  45 # Argument 0 is the type of dump we are searching (rtl, tree, ipa)
  46 # Argument 1 is the regexp to match.
  47 # Argument 2 is the suffix for the dump file
  48 # Argument 3 is the suffix of the dump base
  49 # Argument 4 handles expected failures and the like
  50 proc scan-dump { args } {
  51
  52     if { [llength $args] >= 5 } {
  53         switch [dg-process-target [lindex $args 4]] {
  54             "S" { }
  55             "N" { return }
  56             "F" { setup_xfail "*-*-*" }
  57             "P" { }
  58         }
  59     }
  60
  61     set testcase [testname-for-summary]
  62     # The name might include a list of options; extract the file name.
  63     set filename [lindex $testcase 0]
  64
  65     set printable_pattern [make_pattern_printable [lindex $args 1]]
  66     set suf [dump-suffix [lindex $args 2]]
  67     set testname "$testcase scan-[lindex $args 0]-dump $suf \"$printable_pattern\""
  68     set src [file tail $filename]
  69     set dumpbase [dump-base $src [lindex $args 3]]
  70     set output_file "[glob -nocomplain $dumpbase.[lindex $args 2]]"
  71     if { $output_file == "" } {
  72         verbose -log "$testcase: dump file does not exist"
  73         unresolved "$testname"
  74         return
  75     }
  76
  77     set fd [open $output_file r]
  78     set text [read $fd]
  79     close $fd
  80
  81     if [regexp -- [lindex $args 1] $text] {
  82         pass "$testname"
  83     } else {
  84         fail "$testname"
  85     }
  86 }
  87
  88 # Call pass if pattern is present given number of times, otherwise fail.
  89 # Argument 0 is the type of dump we are searching (rtl, tree, ipa)
  90 # Argument 1 is the regexp to match.
  91 # Argument 2 is number of times the regexp must be found
  92 # Argument 3 is the suffix for the dump file
  93 # Argument 4 is the suffix of the dump base
  94 # Argument 5 handles expected failures and the like
  95 proc scan-dump-times { args } {
  96
  97     if { [llength $args] >= 6 } {
  98         switch [dg-process-target [lindex $args 5]] {
  99             "S" { }
 100             "N" { return }
 101             "F" { setup_xfail "*-*-*" }
 102             "P" { }
 103         }
 104     }
 105
 106     set testcase [testname-for-summary]
 107     # The name might include a list of options; extract the file name.
 108     set filename [lindex $testcase 0]
 109     set times [lindex $args 2]
 110     set suf [dump-suffix [lindex $args 3]]
 111     set printable_pattern [make_pattern_printable [lindex $args 1]]
 112     set testname "$testcase scan-[lindex $args 0]-dump-times $suf \"$printable_pattern\" [lindex $args 2]"
 113     set src [file tail $filename]
 114     set dumpbase [dump-base $src [lindex $args 4]]
 115     set output_file "[glob -nocomplain $dumpbase.[lindex $args 3]]"
 116     if { $output_file == "" } {
 117         verbose -log "$testcase: dump file does not exist"
 118         unresolved "$testname"
 119         return
 120     }
 121
 122     set fd [open $output_file r]
 123     set text [read $fd]
 124     close $fd
 125
 126     set result_count [llength [regexp -inline -all -- [lindex $args 1] $text]]
 127     if {$result_count == $times} {
 128         pass "$testname"
 129     } else {
 130         verbose -log "$testcase: pattern found $result_count times"
 131         fail "$testname"
 132     }
 133 }
 134
 135 # Call pass if pattern is not present, otherwise fail.
 136 #
 137 # Argument 0 is the type of dump we are searching (rtl, tree, ipa)
 138 # Argument 1 is the regexp to match.
 139 # Argument 2 is the suffix for the dump file
 140 # Argument 3 is the suffix of the dump base
 141 # Argument 4 handles expected failures and the like
 142 proc scan-dump-not { args } {
 143
 144     if { [llength $args] >= 5 } {
 145         switch [dg-process-target [lindex $args 4]] {
 146             "S" { }
 147             "N" { return }
 148             "F" { setup_xfail "*-*-*" }
 149             "P" { }
 150         }
 151     }
 152
 153     set testcase [testname-for-summary]
 154     # The name might include a list of options; extract the file name.
 155     set filename [lindex $testcase 0]
 156     set printable_pattern [make_pattern_printable [lindex $args 1]]
 157     set suf [dump-suffix [lindex $args 2]]
 158     set testname "$testcase scan-[lindex $args 0]-dump-not $suf \"$printable_pattern\""
 159     set src [file tail $filename]
 160     set dumpbase [dump-base $src [lindex $args 3]]
 161     set output_file "[glob -nocomplain $dumpbase.[lindex $args 2]]"
 162     if { $output_file == "" } {
 163         verbose -log "$testcase: dump file does not exist"
 164         unresolved "$testname"
 165         return
 166     }
 167
 168     set fd [open $output_file r]
 169     set text [read $fd]
 170     close $fd
 171
 172     if ![regexp -- [lindex $args 1] $text] {
 173         pass "$testname"
 174     } else {
 175         fail "$testname"
 176     }
 177 }
 178
 179 # Utility for scanning demangled compiler result, invoked via dg-final.
 180 # Call pass if pattern is present, otherwise fail.
 181 #
 182 # Argument 0 is the type of dump we are searching (rtl, tree, ipa)
 183 # Argument 1 is the regexp to match.
 184 # Argument 2 is the suffix for the dump file
 185 # Argument 3 is the suffix of the dump base
 186 # Argument 4 handles expected failures and the like
 187 proc scan-dump-dem { args } {
 188     global cxxfilt
 189     global base_dir
 190
 191     if { [llength $args] >= 5 } {
 192         switch [dg-process-target [lindex $args 4]] {
 193             "S" { }
 194             "N" { return }
 195             "F" { setup_xfail "*-*-*" }
 196             "P" { }
 197         }
 198     }
 199
 200     # Find c++filt like we find g++ in g++.exp.
 201     if ![info exists cxxfilt]  {
 202         set cxxfilt [findfile $base_dir/../../../binutils/cxxfilt \
 203                      $base_dir/../../../binutils/cxxfilt \
 204                      [findfile $base_dir/../../c++filt $base_dir/../../c++filt \
 205                       [findfile $base_dir/c++filt $base_dir/c++filt \
 206                        [transform c++filt]]]]
 207         verbose -log "c++filt is $cxxfilt"
 208     }
 209
 210     set testcase [testname-for-summary]
 211     # The name might include a list of options; extract the file name.
 212     set filename [lindex $testcase 0]
 213     set printable_pattern [make_pattern_printable [lindex $args 1]]
 214     set suf [dump-suffix [lindex $args 2]]
 215     set testname "$testcase scan-[lindex $args 0]-dump-dem $suf \"$printable_pattern\""
 216     set src [file tail $filename]
 217     set dumpbase [dump-base $src [lindex $args 3]]
 218     set output_file "[glob -nocomplain $dumpbase.[lindex $args 2]]"
 219     if { $output_file == "" } {
 220         verbose -log "$testcase: dump file does not exist"
 221         unresolved "$testname"
 222         return
 223     }
 224
 225     set fd [open "| $cxxfilt < $output_file" r]
 226     set text [read $fd]
 227     close $fd
 228
 229     if [regexp -- [lindex $args 1] $text] {
 230         pass "$testname"
 231     } else {
 232         fail "$testname"
 233     }
 234 }
 235
 236 # Call pass if demangled pattern is not present, otherwise fail.
 237 #
 238 # Argument 0 is the type of dump we are searching (rtl, tree, ipa)
 239 # Argument 1 is the regexp to match.
 240 # Argument 2 is the suffix for the dump file
 241 # Argument 3 is the suffix of the dump base
 242 # Argument 4 handles expected failures and the like
 243 proc scan-dump-dem-not { args } {
 244     global cxxfilt
 245     global base_dir
 246
 247     if { [llength $args] >= 5 } {
 248         switch [dg-process-target [lindex $args 4]] {
 249             "S" { }
 250             "N" { return }
 251             "F" { setup_xfail "*-*-*" }
 252             "P" { }
 253         }
 254     }
 255
 256     # Find c++filt like we find g++ in g++.exp.
 257     if ![info exists cxxfilt]  {
 258         set cxxfilt [findfile $base_dir/../../../binutils/cxxfilt \
 259                      $base_dir/../../../binutils/cxxfilt \
 260                      [findfile $base_dir/../../c++filt $base_dir/../../c++filt \
 261                       [findfile $base_dir/c++filt $base_dir/c++filt \
 262                        [transform c++filt]]]]
 263         verbose -log "c++filt is $cxxfilt"
 264     }
 265
 266     set testcase [testname-for-summary]
 267     # The name might include a list of options; extract the file name.
 268     set filename [lindex $testcase 0]
 269     set printable_pattern [make_pattern_printable [lindex $args 1]
 270     set suf [dump-suffix [lindex $args 2]]
 271     set testname "$testcase scan-[lindex $args 0]-dump-dem-not $suf \"$printable_pattern\""
 272     set src [file tail $filename]
 273     set dumpbase [dump-base $src [lindex $args 3]]
 274     set output_file "[glob -nocomplain $dumpbase.[lindex $args 2]]"
 275     if { $output_file == "" } {
 276         verbose -log "$testcase: dump file does not exist"
 277         unresolved "$testname"
 278         return
 279     }
 280
 281     set fd [open "| $cxxfilt < $output_file" r]
 282     set text [read $fd]
 283     close $fd
 284
 285     if ![regexp -- [lindex $args 1] $text] {
 286         pass "$testname"
 287     } else {
 288         fail "$testname"
 289     }
 290 }