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