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