# Copyright (C) 2001, 2003, 2004, 2007 Free Software Foundation, Inc. # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with GCC; see the file COPYING3. If not see # . load_lib wrapper.exp # # ${tool}_check_compile -- Reports and returns pass/fail for a compilation # proc ${tool}_check_compile {testcase option objname gcc_output} { global tool set fatal_signal "*cc: Internal compiler error: program*got fatal signal" if [string match "$fatal_signal 6" $gcc_output] then { ${tool}_fail $testcase "Got Signal 6, $option" return 0 } if [string match "$fatal_signal 11" $gcc_output] then { ${tool}_fail $testcase "Got Signal 11, $option" return 0 } if [string match "*internal compiler error*" $gcc_output] then { ${tool}_fail $testcase "$option (internal compiler error)" return 0 } # We shouldn't get these because of -w, but just in case. if [string match "*cc:*warning:*" $gcc_output] then { warning "$testcase: (with warnings) $option" send_log "$gcc_output\n" unresolved "$testcase, $option" return 0 } set gcc_output [prune_warnings $gcc_output] set unsupported_message [${tool}_check_unsupported_p $gcc_output] if { $unsupported_message != "" } { unsupported "$testcase: $unsupported_message" return 0 } # remove any leftover LF/CR to make sure any output is legit regsub -all -- "\[\r\n\]*" $gcc_output "" gcc_output # If any message remains, we fail. if ![string match "" $gcc_output] then { ${tool}_fail $testcase $option return 0 } # fail if the desired object file doesn't exist. # FIXME: there's no way of checking for existence on a remote host. if {$objname != "" && ![is3way] && ![file exists $objname]} { ${tool}_fail $testcase $option return 0 } ${tool}_pass $testcase $option return 1 } # # ${tool}_pass -- utility to record a testcase passed # proc ${tool}_pass { testcase cflags } { if { "$cflags" == "" } { pass "$testcase" } else { pass "$testcase, $cflags" } } # # ${tool}_fail -- utility to record a testcase failed # proc ${tool}_fail { testcase cflags } { if { "$cflags" == "" } { fail "$testcase" } else { fail "$testcase, $cflags" } } # # ${tool}_finish -- called at the end of every script that calls ${tool}_init # # Hide all quirks of the testing environment from the testsuites. Also # undo anything that ${tool}_init did that needs undoing. # proc ${tool}_finish { } { # The testing harness apparently requires this. global errorInfo if [info exists errorInfo] then { unset errorInfo } # Might as well reset these (keeps our caller from wondering whether # s/he has to or not). global prms_id bug_id set prms_id 0 set bug_id 0 } # # ${tool}_exit -- Does final cleanup when testing is complete # proc ${tool}_exit { } { global gluefile if [info exists gluefile] { file_on_build delete $gluefile unset gluefile } } # # ${tool}_check_unsupported_p -- Check the compiler(/assembler/linker) output # for text indicating that the testcase should be marked as "unsupported" # # Utility used by mike-gcc.exp and c-torture.exp. # When dealing with a large number of tests, it's difficult to weed out the # ones that are too big for a particular cpu (eg: 16 bit with a small amount # of memory). There are various ways to deal with this. Here's one. # Fortunately, all of the cases where this is likely to happen will be using # gld so we can tell what the error text will look like. # proc ${tool}_check_unsupported_p { output } { if [regexp "(^|\n)\[^\n\]*: region \[^\n\]* is full" $output] { return "memory full" } return "" } # # runtest_file_p -- Provide a definition for older dejagnu releases # and assume the old syntax: foo1.exp bar1.c foo2.exp bar2.c. # (delete after next dejagnu release). # if { [info procs runtest_file_p] == "" } then { proc runtest_file_p { runtests testcase } { if { $runtests != "" && [regexp "\[.\]\[cC\]" $runtests] } then { if { [lsearch $runtests [file tail $testcase]] >= 0 } then { return 1 } else { return 0 } } return 1 } } # Record additional sources files that must be compiled along with the # main source file. set additional_sources "" proc dg-additional-sources { args } { global additional_sources set additional_sources [lindex $args 1] } # Record additional files -- other than source files -- that must be # present on the system where the compiler runs. set additional_files "" proc dg-additional-files { args } { global additional_files set additional_files [lindex $args 1] } # Return an updated version of OPTIONS that mentions any additional # source files registered with dg-additional-sources. SOURCE is the # name of the test case. proc dg-additional-files-options { options source } { global additional_sources global additional_files set to_download [list] if { $additional_sources != "" } then { if [is_remote host] { lappend options "additional_flags=$additional_sources" } regsub -all "^| " $additional_sources " [file dirname $source]/" additional_sources if ![is_remote host] { lappend options "additional_flags=$additional_sources" } set to_download [concat $to_download $additional_sources] set additional_sources "" } if { $additional_files != "" } then { regsub -all " " $additional_files " [file dirname $source]/" additional_files set to_download [concat $to_download $additional_files] set additional_files "" } if [is_remote host] { foreach file $to_download { remote_download host $file } } return $options } # Return a colon-separate list of directories to search for libraries # for COMPILER, including multilib directories. proc gcc-set-multilib-library-path { compiler } { global rootme # ??? rootme will not be set when testing an installed compiler. # In that case, we should perhaps use some other method to find # libraries. if {![info exists rootme]} { return "" } set libpath ":${rootme}" set compiler [lindex $compiler 0] if { [is_remote host] == 0 && [which $compiler] != 0 } { foreach i "[exec $compiler --print-multi-lib]" { set mldir "" regexp -- "\[a-z0-9=_/\.-\]*;" $i mldir set mldir [string trimright $mldir "\;@"] if { "$mldir" == "." } { continue } if { [llength [glob -nocomplain ${rootme}/${mldir}/libgcc_s*.so.*]] >= 1 } { append libpath ":${rootme}/${mldir}" } } } return $libpath }