gcc/testsuite/lib/scanasm.exp

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