gcc/testsuite/lib/gcc-defs.exp

   1 # Copyright (C) 2001, 2003, 2004 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, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  16
  17 load_lib wrapper.exp
  18
  19 #
  20 # ${tool}_check_compile -- Reports and returns pass/fail for a compilation
  21 #
  22
  23 proc ${tool}_check_compile {testcase option objname gcc_output} {
  24     global tool
  25     set fatal_signal "*cc: Internal compiler error: program*got fatal signal"
  26
  27     if [string match "$fatal_signal 6" $gcc_output] then {
  28         ${tool}_fail $testcase "Got Signal 6, $option"
  29         return 0
  30     }
  31
  32     if [string match "$fatal_signal 11" $gcc_output] then {
  33         ${tool}_fail $testcase "Got Signal 11, $option"
  34         return 0
  35     }
  36
  37     if [string match "*internal compiler error*" $gcc_output] then {
  38         ${tool}_fail $testcase "$option (internal compiler error)"
  39         return 0
  40     }
  41
  42     # We shouldn't get these because of -w, but just in case.
  43     if [string match "*cc:*warning:*" $gcc_output] then {
  44         warning "$testcase: (with warnings) $option"
  45         send_log "$gcc_output\n"
  46         unresolved "$testcase, $option"
  47         return 0
  48     }
  49
  50     set gcc_output [prune_warnings $gcc_output]
  51
  52     set unsupported_message [${tool}_check_unsupported_p $gcc_output]
  53     if { $unsupported_message != "" } {
  54         unsupported "$testcase: $unsupported_message"
  55         return 0
  56     }
  57
  58     # remove any leftover LF/CR to make sure any output is legit
  59     regsub -all -- "\[\r\n\]*" $gcc_output "" gcc_output
  60
  61     # If any message remains, we fail.
  62     if ![string match "" $gcc_output] then {
  63         ${tool}_fail $testcase $option
  64         return 0
  65     }
  66
  67     # fail if the desired object file doesn't exist.
  68     # FIXME: there's no way of checking for existence on a remote host.
  69     if {$objname != "" && ![is3way] && ![file exists $objname]} {
  70         ${tool}_fail $testcase $option
  71         return 0
  72     }
  73
  74     ${tool}_pass $testcase $option
  75     return 1
  76 }
  77
  78 #
  79 # ${tool}_pass -- utility to record a testcase passed
  80 #
  81
  82 proc ${tool}_pass { testcase cflags } {
  83     if { "$cflags" == "" } {
  84         pass "$testcase"
  85     } else {
  86         pass "$testcase, $cflags"
  87     }
  88 }
  89
  90 #
  91 # ${tool}_fail -- utility to record a testcase failed
  92 #
  93
  94 proc ${tool}_fail { testcase cflags } {
  95     if { "$cflags" == "" } {
  96         fail "$testcase"
  97     } else {
  98         fail "$testcase, $cflags"
  99     }
 100 }
 101
 102 #
 103 # ${tool}_finish -- called at the end of every script that calls ${tool}_init
 104 #
 105 # Hide all quirks of the testing environment from the testsuites.  Also
 106 # undo anything that ${tool}_init did that needs undoing.
 107 #
 108
 109 proc ${tool}_finish { } {
 110     # The testing harness apparently requires this.
 111     global errorInfo
 112
 113     if [info exists errorInfo] then {
 114         unset errorInfo
 115     }
 116
 117     # Might as well reset these (keeps our caller from wondering whether
 118     # s/he has to or not).
 119     global prms_id bug_id
 120     set prms_id 0
 121     set bug_id 0
 122 }
 123
 124 #
 125 # ${tool}_exit -- Does final cleanup when testing is complete
 126 #
 127
 128 proc ${tool}_exit { } {
 129     global gluefile
 130
 131     if [info exists gluefile] {
 132         file_on_build delete $gluefile
 133         unset gluefile
 134     }
 135 }
 136
 137 #
 138 # ${tool}_check_unsupported_p -- Check the compiler(/assembler/linker) output
 139 #       for text indicating that the testcase should be marked as "unsupported"
 140 #
 141 # Utility used by mike-gcc.exp and c-torture.exp.
 142 # When dealing with a large number of tests, it's difficult to weed out the
 143 # ones that are too big for a particular cpu (eg: 16 bit with a small amount
 144 # of memory).  There are various ways to deal with this.  Here's one.
 145 # Fortunately, all of the cases where this is likely to happen will be using
 146 # gld so we can tell what the error text will look like.
 147 #
 148
 149 proc ${tool}_check_unsupported_p { output } {
 150     if [regexp "(^|\n)\[^\n\]*: region \[^\n\]* is full" $output] {
 151         return "memory full"
 152     }
 153     return ""
 154 }
 155
 156 #
 157 # runtest_file_p -- Provide a definition for older dejagnu releases
 158 #                   and assume the old syntax: foo1.exp bar1.c foo2.exp bar2.c.
 159 #                   (delete after next dejagnu release).
 160 #
 161
 162 if { [info procs runtest_file_p] == "" } then {
 163     proc runtest_file_p { runtests testcase } {
 164         if { $runtests != "" && [regexp "\[.\]\[cC\]" $runtests] } then {
 165             if { [lsearch $runtests [file tail $testcase]] >= 0 } then {
 166                 return 1
 167             } else {
 168                 return 0
 169             }
 170         }
 171         return 1
 172     }
 173 }
 174
 175 # Record additional sources files that must be compiled along with the
 176 # main source file.
 177
 178 set additional_sources ""
 179
 180 proc dg-additional-sources { args } {
 181     global additional_sources
 182     set additional_sources [lindex $args 1]
 183 }
 184
 185 # Record additional files -- other than source files -- that must be
 186 # present on the system where the compiler runs.
 187
 188 set additional_files ""
 189
 190 proc dg-additional-files { args } {
 191     global additional_files
 192     set additional_files [lindex $args 1]
 193 }
 194
 195 # Return an updated version of OPTIONS that mentions any additional
 196 # source files registered with dg-additional-sources.  SOURCE is the
 197 # name of the test case.
 198
 199 proc dg-additional-files-options { options source } {
 200     global additional_sources
 201     global additional_files
 202     set to_download [list]
 203     if { $additional_sources != "" } then {
 204         if [is_remote host] {
 205             lappend options "additional_flags=$additional_sources"
 206         }
 207         regsub -all "^| " $additional_sources " [file dirname $source]/" additional_sources
 208         if ![is_remote host] {
 209             lappend options "additional_flags=$additional_sources"
 210         }
 211         set to_download [concat $to_download $additional_sources]
 212         set additional_sources ""
 213     }
 214     if { $additional_files != "" } then {
 215         regsub -all " " $additional_files " [file dirname $source]/" additional_files
 216         set to_download [concat $to_download $additional_files]
 217         set additional_files ""
 218     }
 219     if [is_remote host] {
 220         foreach file $to_download {
 221             remote_download host $file
 222         }
 223     }
 224
 225     return $options
 226 }
 227
 228 # Return a colon-separate list of directories to search for libraries
 229 # for COMPILER, including multilib directories.
 230
 231 proc gcc-set-multilib-library-path { compiler } {
 232     global rootme
 233
 234     # ??? rootme will not be set when testing an installed compiler.
 235     # In that case, we should perhaps use some other method to find
 236     # libraries.
 237     if {![info exists rootme]} {
 238         return ""
 239     }
 240
 241     set libpath ":${rootme}"
 242     set compiler [lindex $compiler 0]
 243     if { [is_remote host] == 0 && [which $compiler] != 0 } {
 244         foreach i "[exec $compiler --print-multi-lib]" {
 245             set mldir ""
 246             regexp -- "\[a-z0-9=_/\.-\]*;" $i mldir
 247             set mldir [string trimright $mldir "\;@"]
 248             if { "$mldir" == "." } {
 249                 continue
 250             }
 251             if { [llength [glob -nocomplain ${rootme}/${mldir}/libgcc_s*.so.*]] >= 1 } {
 252                 append libpath ":${rootme}/${mldir}"
 253             }
 254         }
 255     }
 256
 257     return $libpath
 258 }