gcc/testsuite/lib/gcc-defs.exp

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