gcc/testsuite/lib/scandump.exp

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