Subversion Repositories scarts

# Copyright (C) 2001, 2003, 2004 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 2 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 this program; if not, write to the Free Software

# Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.

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

    }

    # 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

}