gcc/testsuite/lib/scanasm.exp

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