gcc/testsuite/lib/scandump.exp

   1 # Copyright (C) 2000, 2002, 2003, 2005, 2007, 2008
   2 # Free Software Foundation, Inc.
   3
   4 # This program is free software; you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation; either version 3 of the License, or
   7 # (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with GCC; see the file COPYING3.  If not see
  16 # <http://www.gnu.org/licenses/>.
  17
  18 # Various utilities for scanning dump output, used by gcc-dg.exp and
  19 # g++-dg.exp.
  20 #
  21 # This is largely borrowed from scanasm.exp.
  22
  23 # Extract the constant part of the dump file suffix from the regexp.
  24 # Argument 0 is the regular expression.
  25 proc dump-suffix { arg } {
  26     set idx [expr [string last "." $arg] + 1]
  27     return [string range $arg $idx end]
  28 }
  29
  30 # Utility for scanning compiler result, invoked via dg-final.
  31 # Call pass if pattern is present, otherwise fail.
  32 #
  33 # Argument 0 is the type of dump we are searching (rtl, tree, ipa)
  34 # Argument 1 is the regexp to match.
  35 # Argument 2 is the suffix for the dump file
  36 # Argument 3 handles expected failures and the like
  37 proc scan-dump { args } {
  38
  39     if { [llength $args] >= 4 } {
  40         switch [dg-process-target [lindex $args 3]] {
  41             "S" { }
  42             "N" { return }
  43             "F" { setup_xfail "*-*-*" }
  44             "P" { }
  45         }
  46     }
  47
  48     # This assumes that we are three frames down from dg-test, and that
  49     # it still stores the filename of the testcase in a local variable "name".
  50     # A cleaner solution would require a new DejaGnu release.
  51     upvar 3 name testcase
  52
  53     set suf [dump-suffix [lindex $args 2]]
  54     set testname "$testcase scan-[lindex $args 0]-dump $suf \"[lindex $args 1]\""
  55     set src [file tail [lindex $testcase 0]]
  56     set output_file "[glob -nocomplain $src.[lindex $args 2]]"
  57     if { $output_file == "" } {
  58         fail "$testname: dump file does not exist"
  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     # This assumes that we are three frames down from dg-test, and that
  91     # it still stores the filename of the testcase in a local variable "name".
  92     # A cleaner solution would require a new DejaGnu release.
  93     upvar 3 name testcase
  94
  95     set suf [dump-suffix [lindex $args 3]]
  96     set testname "$testcase scan-[lindex $args 0]-dump-times $suf \"[lindex $args 1]\" [lindex $args 2]"
  97     set src [file tail [lindex $testcase 0]]
  98     set output_file "[glob -nocomplain $src.[lindex $args 3]]"
  99     if { $output_file == "" } {
 100         fail "$testname: dump file does not exist"
 101         return
 102     }
 103
 104     set fd [open $output_file r]
 105     set text [read $fd]
 106     close $fd
 107
 108     if { [llength [regexp -inline -all -- [lindex $args 1] $text]] == [lindex $args 2]} {
 109         pass "$testname"
 110     } else {
 111         fail "$testname"
 112     }
 113 }
 114
 115 # Call pass if pattern is not present, otherwise fail.
 116 #
 117 # Argument 0 is the type of dump we are searching (rtl, tree, ipa)
 118 # Argument 1 is the regexp to match.
 119 # Argument 2 is the suffix for the dump file
 120 # Argument 3 handles expected failures and the like
 121 proc scan-dump-not { args } {
 122
 123     if { [llength $args] >= 4 } {
 124         switch [dg-process-target [lindex $args 3]] {
 125             "S" { }
 126             "N" { return }
 127             "F" { setup_xfail "*-*-*" }
 128             "P" { }
 129         }
 130     }
 131
 132     # This assumes that we are three frames down from dg-test, and that
 133     # it still stores the filename of the testcase in a local variable "name".
 134     # A cleaner solution would require a new DejaGnu release.
 135     upvar 3 name testcase
 136
 137     set suf [dump-suffix [lindex $args 2]]
 138     set testname "$testcase scan-[lindex $args 0]-dump-not $suf \"[lindex $args 1]\""
 139     set src [file tail [lindex $testcase 0]]
 140     set output_file "[glob -nocomplain $src.[lindex $args 2]]"
 141     if { $output_file == "" } {
 142         fail "$testname: dump file does not exist"
 143         return
 144     }
 145
 146     set fd [open $output_file r]
 147     set text [read $fd]
 148     close $fd
 149
 150     if ![regexp -- [lindex $args 1] $text] {
 151         pass "$testname"
 152     } else {
 153         fail "$testname"
 154     }
 155 }
 156
 157 # Utility for scanning demangled compiler result, invoked via dg-final.
 158 # Call pass if pattern is present, otherwise fail.
 159 #
 160 # Argument 0 is the type of dump we are searching (rtl, tree, ipa)
 161 # Argument 1 is the regexp to match.
 162 # Argument 2 is the suffix for the dump file
 163 # Argument 3 handles expected failures and the like
 164 proc scan-dump-dem { args } {
 165     global cxxfilt
 166     global base_dir
 167
 168     if { [llength $args] >= 4 } {
 169         switch [dg-process-target [lindex $args 3]] {
 170             "S" { }
 171             "N" { return }
 172             "F" { setup_xfail "*-*-*" }
 173             "P" { }
 174         }
 175     }
 176
 177     # Find c++filt like we find g++ in g++.exp.
 178     if ![info exists cxxfilt]  {
 179         set cxxfilt [findfile $base_dir/../../../binutils/cxxfilt \
 180                      $base_dir/../../../binutils/cxxfilt \
 181                      [findfile $base_dir/../../c++filt $base_dir/../../c++filt \
 182                       [findfile $base_dir/c++filt $base_dir/c++filt \
 183                        [transform c++filt]]]]
 184         verbose -log "c++filt is $cxxfilt"
 185     }
 186
 187     upvar 3 name testcase
 188     set suf [dump-suffix [lindex $args 2]]
 189     set testname "$testcase scan-[lindex $args 0]-dump-dem $suf \"[lindex $args 1]\""
 190     set src [file tail [lindex $testcase 0]]
 191     set output_file "[glob -nocomplain $src.[lindex $args 2]]"
 192     if { $output_file == "" } {
 193         fail "$testname: dump file does not exist"
 194         return
 195     }
 196
 197     set fd [open "| $cxxfilt < $output_file" r]
 198     set text [read $fd]
 199     close $fd
 200
 201     if [regexp -- [lindex $args 1] $text] {
 202         pass "$testname"
 203     } else {
 204         fail "$testname"
 205     }
 206 }
 207
 208 # Call pass if demangled pattern is not present, otherwise fail.
 209 #
 210 # Argument 0 is the type of dump we are searching (rtl, tree, ipa)
 211 # Argument 1 is the regexp to match.
 212 # Argument 2 is the suffix for the dump file
 213 # Argument 3 handles expected failures and the like
 214 proc scan-dump-dem-not { args } {
 215     global cxxfilt
 216     global base_dir
 217
 218     if { [llength $args] >= 4 } {
 219         switch [dg-process-target [lindex $args 3]] {
 220             "S" { }
 221             "N" { return }
 222             "F" { setup_xfail "*-*-*" }
 223             "P" { }
 224         }
 225     }
 226
 227     # Find c++filt like we find g++ in g++.exp.
 228     if ![info exists cxxfilt]  {
 229         set cxxfilt [findfile $base_dir/../../../binutils/cxxfilt \
 230                      $base_dir/../../../binutils/cxxfilt \
 231                      [findfile $base_dir/../../c++filt $base_dir/../../c++filt \
 232                       [findfile $base_dir/c++filt $base_dir/c++filt \
 233                        [transform c++filt]]]]
 234         verbose -log "c++filt is $cxxfilt"
 235     }
 236
 237     upvar 3 name testcase
 238
 239     set suf [dump-suffix [lindex $args 2]]
 240     set testname "$testcase scan-[lindex $args 0]-dump-dem-not $suf \"[lindex $args 1]\""
 241     set src [file tail [lindex $testcase 0]]
 242     set output_file "[glob -nocomplain $src.[lindex $args 2]]"
 243     if { $output_file == "" } {
 244         fail "$testname: dump file does not exist"
 245         return
 246     }
 247
 248     set fd [open "| $cxxfilt < $output_file" r]
 249     set text [read $fd]
 250     close $fd
 251
 252     if ![regexp -- [lindex $args 1] $text] {
 253         pass "$testname"
 254     } else {
 255         fail "$testname"
 256     }
 257 }