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" { error "scan-assembler: `xfail' not allowed here" }
  36             "P" { error "scan-assembler: `xfail' not allowed here" }
  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 not present, otherwise fail.
  60 proc scan-assembler-not { args } {
  61     if { [llength $args] < 1 } {
  62         error "scan-assembler-not: too few arguments"
  63         return
  64     }
  65     if { [llength $args] > 2 } {
  66         error "scan-assembler-not: too many arguments"
  67         return
  68     }
  69     if { [llength $args] >= 2 } {
  70         switch [dg-process-target [lindex $args 1]] {
  71             "S" { }
  72             "N" { return }
  73             "F" { error "scan-assembler-not: `xfail' not allowed here" }
  74             "P" { error "scan-assembler-not: `xfail' not allowed here" }
  75         }
  76     }
  77
  78     upvar 2 name testcase
  79     set output_file "[file rootname [file tail $testcase]].s"
  80
  81     set fd [open $output_file r]
  82     set text [read $fd]
  83     close $fd
  84
  85     if ![regexp -- [lindex $args 0] $text] {
  86         pass "$testcase scan-assembler-not [lindex $args 0]"
  87     } else {
  88         fail "$testcase scan-assembler-not [lindex $args 0]"
  89     }
  90 }
  91
  92 # Utility for scanning demangled compiler result, invoked via dg-final.
  93 # Call pass if pattern is present, otherwise fail.
  94 proc scan-assembler-dem { args } {
  95     global cxxfilt
  96     global base_dir
  97
  98     if { [llength $args] < 1 } {
  99         error "scan-assembler-dem: too few arguments"
 100         return
 101     }
 102     if { [llength $args] > 2 } {
 103         error "scan-assembler-dem: too many arguments"
 104         return
 105     }
 106     if { [llength $args] >= 2 } {
 107         switch [dg-process-target [lindex $args 1]] {
 108             "S" { }
 109             "N" { return }
 110             "F" { error "[lindex $args 0]: `xfail' not allowed here" }
 111             "P" { error "[lindex $args 0]: `xfail' not allowed here" }
 112         }
 113     }
 114
 115     # Find c++filt like we find g++ in g++.exp.
 116     if ![info exists cxxfilt]  {
 117         set cxxfilt [findfile $base_dir/../c++filt $base_dir/../c++filt \
 118                      [findfile $base_dir/c++filt $base_dir/c++filt \
 119                       [transform c++filt]]]
 120         verbose -log "c++filt is $cxxfilt"
 121     }
 122
 123     upvar 2 name testcase
 124     set output_file "[file rootname [file tail $testcase]].s"
 125
 126     set fd [open "| $cxxfilt < $output_file" r]
 127     set text [read $fd]
 128     close $fd
 129
 130     if [regexp -- [lindex $args 0] $text] {
 131         pass "$testcase scan-assembler-dem [lindex $args 0]"
 132     } else {
 133         fail "$testcase scan-assembler-dem [lindex $args 0]"
 134     }
 135 }
 136
 137 # Call pass if demangled pattern is not present, otherwise fail.
 138 proc scan-assembler-dem-not { args } {
 139     global cxxfilt
 140     global base_dir
 141
 142     if { [llength $args] < 1 } {
 143         error "scan-assembler-dem-not: too few arguments"
 144         return
 145     }
 146     if { [llength $args] > 2 } {
 147         error "scan-assembler-dem-not: too many arguments"
 148         return
 149     }
 150     if { [llength $args] >= 2 } {
 151         switch [dg-process-target [lindex $args 1]] {
 152             "S" { }
 153             "N" { return }
 154             "F" { error "scan-assembler-dem-not: `xfail' not allowed here" }
 155             "P" { error "scan-assembler-dem-not: `xfail' not allowed here" }
 156         }
 157     }
 158
 159     # Find c++filt like we find g++ in g++.exp.
 160     if ![info exists cxxfilt]  {
 161         set cxxfilt [findfile $base_dir/../c++filt $base_dir/../c++filt \
 162                      [findfile $base_dir/c++filt $base_dir/c++filt \
 163                       [transform c++filt]]]
 164         verbose -log "c++filt is $cxxfilt"
 165     }
 166
 167     # Find c++filt like we find g++ in g++.exp.
 168     if ![info exists cxxfilt]  {
 169         set cxxfilt [findfile $base_dir/../c++filt $base_dir/../c++filt \
 170                      [findfile $base_dir/c++filt $base_dir/c++filt \
 171                       [transform c++filt]]]
 172         verbose -log "c++filt is $cxxfilt"
 173     }
 174
 175     upvar 2 name testcase
 176     set output_file "[file rootname [file tail $testcase]].s"
 177
 178     set fd [open "| $cxxfilt < $output_file" r]
 179     set text [read $fd]
 180     close $fd
 181
 182     if ![regexp -- [lindex $args 0] $text] {
 183         pass "$testcase scan-assembler-dem-not [lindex $args 0]"
 184     } else {
 185         fail "$testcase scan-assembler-dem-not [lindex $args 0]"
 186     }
 187 }