gcc/testsuite/lib/scandump.exp

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