gcc/testsuite/lib/scandump.exp

   1 #   Copyright (C) 2000, 2002, 2003, 2005 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 2 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 this program; if not, write to the Free Software
  15 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  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 # Utility for scanning compiler result, invoked via dg-final.
  23 # Call pass if pattern is present, otherwise fail.
  24 #
  25 # Argument 0 is the type of dump we are searching (rtl, tree, ipa)
  26 # Argument 1 is the regexp to match.
  27 # Argument 2 is the suffix for the dump file
  28 # Argument 3 handles expected failures and the like
  29 proc scan-dump { args } {
  30
  31     if { [llength $args] >= 4 } {
  32         switch [dg-process-target [lindex $args 3]] {
  33             "S" { }
  34             "N" { return }
  35             "F" { setup_xfail "*-*-*" }
  36             "P" { }
  37         }
  38     }
  39
  40     # This assumes that we are three frames down from dg-test, and that
  41     # it still stores the filename of the testcase in a local variable "name".
  42     # A cleaner solution would require a new DejaGnu release.
  43     upvar 3 name testcase
  44
  45     set src [file tail [lindex $testcase 0]]
  46     set output_file "[glob $src.[lindex $args 2]]"
  47
  48     set fd [open $output_file r]
  49     set text [read $fd]
  50     close $fd
  51
  52     if [regexp -- [lindex $args 1] $text] {
  53         pass "$testcase scan-[lindex $args 0]-dump [lindex $args 1]"
  54     } else {
  55         fail "$testcase scan-[lindex $args 0]-dump [lindex $args 1]"
  56     }
  57 }
  58
  59 # Call pass if pattern is present given number of times, otherwise fail.
  60 # Argument 0 is the type of dump we are searching (rtl, tree, ipa)
  61 # Argument 1 is the regexp to match.
  62 # Argument 2 is number of times the regexp must be found
  63 # Argument 3 is the suffix for the dump file
  64 # Argument 4 handles expected failures and the like
  65 proc scan-dump-times { args } {
  66
  67     if { [llength $args] >= 5 } {
  68         switch [dg-process-target [lindex $args 4]] {
  69             "S" { }
  70             "N" { return }
  71             "F" { setup_xfail "*-*-*" }
  72             "P" { }
  73         }
  74     }
  75
  76     # This assumes that we are three frames down from dg-test, and that
  77     # it still stores the filename of the testcase in a local variable "name".
  78     # A cleaner solution would require a new DejaGnu release.
  79     upvar 3 name testcase
  80
  81     set src [file tail [lindex $testcase 0]]
  82     set output_file "[glob $src.[lindex $args 3]]"
  83
  84     set fd [open $output_file r]
  85     set text [read $fd]
  86     close $fd
  87
  88     if { [llength [regexp -inline -all -- [lindex $args 1] $text]] == [lindex $args 2]} {
  89         pass "$testcase scan-[lindex $args 0]-dump-times [lindex $args 1] [lindex $args 2]"
  90     } else {
  91         fail "$testcase scan-[lindex $args 0]-dump-times [lindex $args 1] [lindex $args 2]"
  92     }
  93 }
  94
  95 # Call pass if pattern is not present, otherwise fail.
  96 #
  97 # Argument 0 is the type of dump we are searching (rtl, tree, ipa)
  98 # Argument 1 is the regexp to match.
  99 # Argument 2 is the suffix for the dump file
 100 # Argument 3 handles expected failures and the like
 101 proc scan-dump-not { args } {
 102
 103     if { [llength $args] >= 4 } {
 104         switch [dg-process-target [lindex $args 3]] {
 105             "S" { }
 106             "N" { return }
 107             "F" { setup_xfail "*-*-*" }
 108             "P" { }
 109         }
 110     }
 111
 112     # This assumes that we are three frames down from dg-test, and that
 113     # it still stores the filename of the testcase in a local variable "name".
 114     # A cleaner solution would require a new DejaGnu release.
 115     upvar 3 name testcase
 116     set src [file tail [lindex $testcase 0]]
 117     set output_file "[glob $src.[lindex $args 2]]"
 118
 119     set fd [open $output_file r]
 120     set text [read $fd]
 121     close $fd
 122
 123     if ![regexp -- [lindex $args 1] $text] {
 124         pass "$testcase scan-[lindex $args 0]-dump-not [lindex $args 1]"
 125     } else {
 126         fail "$testcase scan-[lindex $args 0]-dump-not [lindex $args 1]"
 127     }
 128 }
 129
 130 # Utility for scanning demangled compiler result, invoked via dg-final.
 131 # Call pass if pattern is present, otherwise fail.
 132 #
 133 # Argument 0 is the type of dump we are searching (rtl, tree, ipa)
 134 # Argument 1 is the regexp to match.
 135 # Argument 2 is the suffix for the dump file
 136 # Argument 3 handles expected failures and the like
 137 proc scan-dump-dem { args } {
 138     global cxxfilt
 139     global base_dir
 140
 141     if { [llength $args] >= 4 } {
 142         switch [dg-process-target [lindex $args 3]] {
 143             "S" { }
 144             "N" { return }
 145             "F" { setup_xfail "*-*-*" }
 146             "P" { }
 147         }
 148     }
 149
 150     # Find c++filt like we find g++ in g++.exp.
 151     if ![info exists cxxfilt]  {
 152         set cxxfilt [findfile $base_dir/../../binutils/cxxfilt \
 153                      $base_dir/../../binutils/cxxfilt \
 154                      [findfile $base_dir/../c++filt $base_dir/../c++filt \
 155                       [findfile $base_dir/c++filt $base_dir/c++filt \
 156                        [transform c++filt]]]]
 157         verbose -log "c++filt is $cxxfilt"
 158     }
 159
 160     upvar 3 name testcase
 161     set src [file tail [lindex $testcase 0]]
 162     set output_file "[glob $src.[lindex $args 2]]"
 163
 164     set fd [open "| $cxxfilt < $output_file" r]
 165     set text [read $fd]
 166     close $fd
 167
 168     if [regexp -- [lindex $args 1] $text] {
 169         pass "$testcase scan-[lindex $args 0]-dump-dem [lindex $args 1]"
 170     } else {
 171         fail "$testcase scan-[lindex $args 0]-dump-dem [lindex $args 1]"
 172     }
 173 }
 174
 175 # Call pass if demangled pattern is not present, otherwise fail.
 176 #
 177 # Argument 0 is the type of dump we are searching (rtl, tree, ipa)
 178 # Argument 1 is the regexp to match.
 179 # Argument 2 is the suffix for the dump file
 180 # Argument 3 handles expected failures and the like
 181 proc scan-dump-dem-not { args } {
 182     global cxxfilt
 183     global base_dir
 184
 185     if { [llength $args] >= 4 } {
 186         switch [dg-process-target [lindex $args 3]] {
 187             "S" { }
 188             "N" { return }
 189             "F" { setup_xfail "*-*-*" }
 190             "P" { }
 191         }
 192     }
 193
 194     # Find c++filt like we find g++ in g++.exp.
 195     if ![info exists cxxfilt]  {
 196         set cxxfilt [findfile $base_dir/../../binutils/cxxfilt \
 197                      $base_dir/../../binutils/cxxfilt \
 198                      [findfile $base_dir/../c++filt $base_dir/../c++filt \
 199                       [findfile $base_dir/c++filt $base_dir/c++filt \
 200                        [transform c++filt]]]]
 201         verbose -log "c++filt is $cxxfilt"
 202     }
 203
 204     upvar 3 name testcase
 205     set src [file tail [lindex $testcase 0]]
 206     set output_file "[glob $src.[lindex $args 2]]"
 207
 208     set fd [open "| $cxxfilt < $output_file" r]
 209     set text [read $fd]
 210     close $fd
 211
 212     if ![regexp -- [lindex $args 1] $text] {
 213         pass "$testcase scan-[lindex $args 0]-dump-dem-not [lindex $args 1]"
 214     } else {
 215         fail "$testcase scan-[lindex $args 0]-dump-dem-not [lindex $args 1]"
 216     }
 217 }