diff options
Diffstat (limited to 'gcc/testsuite/lib')
| -rwxr-xr-x | gcc/testsuite/lib/c-torture.exp | 282 | ||||
| -rwxr-xr-x | gcc/testsuite/lib/chill.exp | 365 | ||||
| -rwxr-xr-x | gcc/testsuite/lib/gcc-dg.exp | 84 | ||||
| -rwxr-xr-x | gcc/testsuite/lib/gcc.exp | 325 | ||||
| -rwxr-xr-x | gcc/testsuite/lib/mike-gcc.exp | 262 | ||||
| -rwxr-xr-x | gcc/testsuite/lib/old-dejagnu.exp | 585 |
6 files changed, 0 insertions, 1903 deletions
diff --git a/gcc/testsuite/lib/c-torture.exp b/gcc/testsuite/lib/c-torture.exp deleted file mode 100755 index 2078a61..0000000 --- a/gcc/testsuite/lib/c-torture.exp +++ /dev/null @@ -1,282 +0,0 @@ -# Copyright (C) 1992-1998, 1999 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, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -# Please email any bugs, comments, and/or additions to this file to: -# bug-dejagnu@gnu.org. - -# This file was written by Rob Savoye. (rob@cygnus.com) - -# The default option list can be overridden by -# TORTURE_OPTIONS="{ { list1 } ... { listN } }" - -if ![info exists TORTURE_OPTIONS] { - # It is theoretically beneficial to group all of the O2 options together, - # as in many cases the compiler will generate identical executables for - # all of them--and the c-torture testsuite will skip testing identical - # executables multiple times. - set TORTURE_OPTIONS [list \ - { -O0 } { -O1 } { -O2 } \ - { -O2 -fomit-frame-pointer -finline-functions } \ - { -O2 -fomit-frame-pointer -finline-functions -funroll-loops } \ - { -O2 -fomit-frame-pointer -finline-functions -funroll-all-loops } \ - { -O2 -g } { -Os } ] -} - - -# Split TORTURE_OPTIONS into two choices: one for testcases with loops and -# one for testcases without loops. - -set torture_with_loops $TORTURE_OPTIONS -set torture_without_loops "" -foreach option $TORTURE_OPTIONS { - if ![string match "*loop*" $option] { - lappend torture_without_loops $option - } -} - -# -# c-torture-compile -- runs the Tege C-torture test -# -# SRC is the full pathname of the testcase. -# OPTION is the specific compiler flag we're testing (eg: -O2). -# -proc c-torture-compile { src option } { - global output - global srcdir tmpdir - global host_triplet - - set output "$tmpdir/[file tail [file rootname $src]].o" - - regsub "^$srcdir/?" $src "" testcase - # If we couldn't rip $srcdir out of `src' then just do the best we can. - # The point is to reduce the unnecessary noise in the logs. Don't strip - # out too much because different testcases with the same name can confuse - # `test-tool'. - if [string match "/*" $testcase] { - set testcase "[file tail [file dirname $src]]/[file tail $src]" - } - - verbose "Testing $testcase, $option" 1 - - # Run the compiler and analyze the results. - set options "" - lappend options "additional_flags=-w $option" - - set comp_output [gcc_target_compile "$src" "$output" object $options]; - gcc_check_compile $testcase $option $output $comp_output - remote_file build delete $output -} - -# -# c-torture-execute -- utility to compile and execute a testcase -# -# SRC is the full pathname of the testcase. -# -# If the testcase has an associated .x file, we source that to run the -# test instead. We use .x so that we don't lengthen the existing filename -# to more than 14 chars. -# -proc c-torture-execute { src args } { - global tmpdir tool srcdir output - - if { [llength $args] > 0 } { - set additional_flags [lindex $args 0]; - } else { - set additional_flags ""; - } - # Check for alternate driver. - if [file exists [file rootname $src].x] { - verbose "Using alternate driver [file rootname [file tail $src]].x" 2 - set done_p 0 - catch "set done_p \[source [file rootname $src].x\]" - if { $done_p } { - return - } - } - - # Look for a loop within the source code - if we don't find one, - # don't pass -funroll[-all]-loops. - global torture_with_loops torture_without_loops - if [expr [search_for $src "for*("]+[search_for $src "while*("]] then { - set option_list $torture_with_loops - } else { - set option_list $torture_without_loops - } - - set executable $tmpdir/[file tail [file rootname $src].x] - - regsub "^$srcdir/?" $src "" testcase - # If we couldn't rip $srcdir out of `src' then just do the best we can. - # The point is to reduce the unnecessary noise in the logs. Don't strip - # out too much because different testcases with the same name can confuse - # `test-tool'. - if [string match "/*" $testcase] { - set testcase "[file tail [file dirname $src]]/[file tail $src]" - } - - set count 0; - set oldstatus "foo"; - foreach option $option_list { - if { $count > 0 } { - set oldexec $execname; - } - set execname "${executable}${count}"; - incr count; - - # torture_{compile,execute}_xfail are set by the .x script - # (if present) - if [info exists torture_compile_xfail] { - setup_xfail $torture_compile_xfail - } - - # torture_execute_before_{compile,execute} can be set by the .x script - # (if present) - if [info exists torture_eval_before_compile] { - set ignore_me [eval $torture_eval_before_compile] - } - - remote_file build delete $execname; - verbose "Testing $testcase, $option" 1 - - set options "" - lappend options "additional_flags=-w $option" - if { $additional_flags != "" } { - lappend options "additional_flags=$additional_flags"; - } - set comp_output [gcc_target_compile "$src" "${execname}" executable $options]; - - if ![gcc_check_compile "$testcase compilation" $option $execname $comp_output] { - unresolved "$testcase execution, $option" - remote_file build delete $execname - continue - } - - # See if this source file uses "long long" types, if it does, and - # no_long_long is set, skip execution of the test. - if [target_info exists no_long_long] then { - if [expr [search_for $src "long long"]] then { - unsupported "$testcase execution, $option" - continue - } - } - - if [info exists torture_execute_xfail] { - setup_xfail $torture_execute_xfail - } - - if [info exists torture_eval_before_execute] { - set ignore_me [eval $torture_eval_before_execute] - } - - set skip 0; - if [info exists oldexec] { - if { [remote_file build cmp $oldexec $execname] == 0 } { - set skip 1; - } - } - if { $skip == 0 } { - set result [gcc_load "$execname" "" ""] - set status [lindex $result 0]; - set output [lindex $result 1]; - } - if { $oldstatus == "pass" } { - remote_file build delete $oldexec; - } - $status "$testcase execution, $option" - set oldstatus $status; - } - if [info exists status] { - if { $status == "pass" } { - remote_file build delete $execname; - } - } -} - -# -# search_for -- looks for a string match in a file -# -proc search_for { file pattern } { - set fd [open $file r] - while { [gets $fd cur_line]>=0 } { - if [string match "*$pattern*" $cur_line] then { - close $fd - return 1 - } - } - close $fd - return 0 -} - -# -# c-torture -- the c-torture testcase source file processor -# -# This runs compilation only tests (no execute tests). -# SRC is the full pathname of the testcase, or just a file name in which case -# we prepend $srcdir/$subdir. -# -# If the testcase has an associated .x file, we source that to run the -# test instead. We use .x so that we don't lengthen the existing filename -# to more than 14 chars. -# -proc c-torture { args } { - global srcdir subdir - - set src [lindex $args 0]; - if { [llength $args] > 1 } { - set options [lindex $args 1]; - } else { - set options "" - } - - # Prepend $srdir/$subdir if missing. - if ![string match "*/*" $src] { - set src "$srcdir/$subdir/$src" - } - - # Check for alternate driver. - if [file exists [file rootname $src].x] { - verbose "Using alternate driver [file rootname [file tail $src]].x" 2 - set done_p 0 - catch "set done_p \[source [file rootname $src].x\]" - if { $done_p } { - return - } - } - - # Look for a loop within the source code - if we don't find one, - # don't pass -funroll[-all]-loops. - global torture_with_loops torture_without_loops - if [expr [search_for $src "for*("]+[search_for $src "while*("]] then { - set option_list $torture_with_loops - } else { - set option_list $torture_without_loops - } - - # loop through all the options - foreach option $option_list { - # torture_compile_xfail is set by the .x script (if present) - if [info exists torture_compile_xfail] { - setup_xfail $torture_compile_xfail - } - - # torture_execute_before_compile is set by the .x script (if present) - if [info exists torture_eval_before_compile] { - set ignore_me [eval $torture_eval_before_compile] - } - - c-torture-compile $src "$option $options" - } -} diff --git a/gcc/testsuite/lib/chill.exp b/gcc/testsuite/lib/chill.exp deleted file mode 100755 index bd8c4f6..0000000 --- a/gcc/testsuite/lib/chill.exp +++ /dev/null @@ -1,365 +0,0 @@ -# -# Expect script for Chill Regression Tests -# Copyright (C) 1993, 1996, 1997 Free Software Foundation -# -# This file 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, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -# -# Written by Jeffrey Wheat (cassidy@cygnus.com) -# - -# -# chill support library procedures and testsuite specific instructions -# - -# -# default_chill_version -# extract and print the version number of the chill compiler -# exits if compiler does not exist -# -proc default_chill_version { } { - global GCC_UNDER_TEST - - # ignore any arguments after the command - set compiler [lindex $GCC_UNDER_TEST 0] - - # verify that the compiler exists - if {[which $compiler] != 0} then { - set tmp [ exec $compiler -v ] - regexp "version.*$" $tmp version - - if [info exists version] then { - clone_output "[which $compiler] $version\n" - } - } else { - warning "$compiler does not exist" - exit -1 - } -} - -# -# chill_compile -# compile the specified file -# -# returns values: -# return 0 on success -# return 1 on failure with $result containing compiler output -# exit with -1 if compiler doesn't exist -# -# verbosity output: -# 1 - indicate compile in progress -# 2 - indicate compile, target name -# 3 - indicate compile, target name, exec command, and result -# -proc chill_compile { src obj } { - global GCC_UNDER_TEST - global CFLAGS - - global errno - global result - global verbose - - global subdir - global tmpdir - - set errno 0 - set cflags $CFLAGS - set dumpfile [file rootname $obj].cmp ;# name of file to dump stderr in - - # verify that the compiler exists - if { [which $GCC_UNDER_TEST] == 0 } then { - warning "$GCC_UNDER_TEST does not exist" - exit -1 - } - - if { $verbose == 1 } then { - send_user "Compiling... " - } else { - verbose " - CMPL: Compiling [file tail $src]" 2 - } - - # if object type is a grt file, then only build a grant file - if [string match "*.grt" $obj] then { - set cflags [concat $cflags -fgrant-only] - } - - # build command line - set commandline "$GCC_UNDER_TEST $cflags -I$subdir -c $src" - - # write command line to logfile - send_log "\n### EXEC: $commandline\n" - - # tell us whats going on if verbose - verbose "### EXEC: $commandline" 3 - - # exec the compiler with the appropriate flags - set errno [catch "exec $commandline" result] - - # dump compiler's stderr output into $dumpfile - this is a gross hack - set dumpfile [open $dumpfile w+]; puts $dumpfile $result; close $dumpfile - - # log any compiler output unless its null - if ![string match "" $result] then { send_log "\n$result\n" } - unset cflags - return -} - -# -# chill_link -# link the specified files -# -# returns values: -# return 0 on success -# return 1 on failure with $result containing compiler output -# exit with -1 if compiler doesn't exist -# -# verbosity output: -# 1 - indicate linking in progress -# 2 - indicate linking, target name -# 3 - indicate linking, target name, exec command, and result -# -proc chill_link { target } { - global GCC_UNDER_TEST - global CFLAGS - - global errno - global result - global verbose - global tmptarget - - global crt0 - global libs - global objs - - set errno 0 - - # verify that the compiler exists - if { [which $GCC_UNDER_TEST] == 0 } then { - warning "$GCC_UNDER_TEST does not exist" - exit -1 - } - - if { $verbose == 1 } then { - send_user "Linking... " - } else { - verbose " - LINK: Linking [file tail $target]" 2 - } - - # verify that the object exists - if ![file exists $target.o] then { - set errno 1 - set result "file $target.o doesn'timeout exist" - return - } - - # build command line - set commandline "$GCC_UNDER_TEST $CFLAGS -o $target $target.o $objs $crt0 $libs" - - # write command line to logfile - send_log "\n### EXEC: $commandline\n" - - # tell us whats going on if we are verbose - verbose "### EXEC: $commandline" 3 - - # link the objects, sending any linker output to $result - set errno [catch "exec $commandline > $tmptarget.lnk" result] - - # log any linker output unless its null - if ![string match "" $result] then { send_log "\n$result\n" } - return -} - -# -# default_chill_start -# -proc default_chill_start { } { - global srcdir - global subdir - global tmpdir - global verbose - - if { $verbose > 1 } then { send_user "Configuring testsuite... " } - - # tmpdir is obtained from $objdir/site.exp. if not, set it to /tmp - if ![info exists tmpdir] then { set tmpdir /tmp } - - # save and convert $srcdir to an absolute pathname, stomp on the old value - # stomp on $subdir and set to the absolute path to the subdirectory - global osrcdir; set osrcdir $srcdir; set srcdir [cd $srcdir; pwd] - global osubdir; set osubdir $subdir; set subdir $srcdir/$subdir - - # cd the temporary directory, $tmpdir - cd $tmpdir; verbose "### PWD: [pwd]" 5 - - # copy init files to the tmpdir - foreach initfile [glob -nocomplain $subdir/*.init] { - set targfile $tmpdir/[file tail [file rootname $initfile]] - verbose "### EXEC: cp $initfile $targfile" 5 - if [catch "exec cp $initfile $targfile"] then { - send_user "\nConfigure failed.\n" - exit -1 - } - } - if { $verbose > 1 } then { send_user "Configuring finished.\n" } -} - -# -# default_chill_exit -# -# -proc default_chill_exit { } { - global srcdir - global objdir - global tmpdir - global osrcdir - global osubdir - - # reset directory variables - set srcdir $osrcdir; set subdir $osubdir - - # remove all generated targets and objects - verbose "### EXEC: rm -f $tmpdir/*" 3 - catch "exec rm -f $tmpdir/*" result - - # change back to the main object directory - cd $objdir - verbose "### SANITY: [pwd]" 5 -} - -# -# chill_diff -# compare two files line-by-line -# -# returns values: -# return 0 on success -# return 1 if different -# return -1 if output file doesn't exist -# -# verbosity output: -# 1 - indicate diffing in progress -# 2 - indicate diffing, target names -# 3 - indicate diffing, target names, and result -# -proc chill_diff { file_1 file_2 } { - global errno - global result - global target - global tmptarget - - global verbose - - set eof -1 - set errno 0 - set differences 0 - - if { $verbose == 1 } then { - send_user "Diffing... " - } else { - verbose " - DIFF: Diffing [file tail $file_1] [file tail $file_2]" 2 - } - - # write command line to logfile - send_log "### EXEC: diff $file_1 $file_2\n" - - # tell us whats going on if we are verbose - verbose "### EXEC: diff $file_1 $file_2" 3 - - # verify file exists and open it - if [file exists $file_1] then { - set file_a [open $file_1 r] - } else { - set errno -1; set result "$file_1 doesn't exist" - return - } - - # verify file exists and is not zero length, and then open it - if [file exists $file_2] then { - if [file size $file_2]!=0 then { - set file_b [open $file_2 r] - } else { - set errno -1; set result "$file_2 is zero bytes"; return - } - } else { - set errno -1; set result "$file_2 doesn't exist"; return - } - - # spoof the diff routine - lappend list_a $target - - while { [gets $file_a line] != $eof } { - if [regexp "^#.*$" $line] then { - continue - } else { - lappend list_a $line - } - } - close $file_a - - # spoof the diff routine - lappend list_b $target - - while { [gets $file_b line] != $eof } { - if [regexp "^#.*$" $line] then { - continue - } else { - # use [file tail $line] to strip off pathname - lappend list_b [file tail $line] - } - } - close $file_b - - for { set i 0 } { $i < [llength $list_a] } { incr i } { - set line_a [lindex $list_a $i] - set line_b [lindex $list_b $i] - - if [string compare $line_a $line_b] then { - set errno 1 - set count [expr $i+1] - set linenum [format %dc%d $count $count] - verbose "$linenum" 3 - verbose "< $line_a" 3 - verbose "---" 3 - verbose "> $line_b" 3 - - send_log "$file_1: < $count: $line_a\n" - send_log "$file_2: > $count: $line_b\n" - set result "differences found" - } - } - return -} - -# -# chill_fail -# a wrapper around the framework fail proc -# -proc chill_fail { target result } { - global verbose - - if { $verbose == 1 } then { send_user "\n" } - fail $target - verbose "--------------------------------------------------" 3 - verbose "### RESULT: $result" 3 -} - -# -# chill_pass -# a wrapper around the framework fail proc -# -proc chill_pass { target } { - global verbose - - if { $verbose == 1 } then { send_user "\n" } - pass $target -} diff --git a/gcc/testsuite/lib/gcc-dg.exp b/gcc/testsuite/lib/gcc-dg.exp deleted file mode 100755 index 04cb8b7..0000000 --- a/gcc/testsuite/lib/gcc-dg.exp +++ /dev/null @@ -1,84 +0,0 @@ -# Copyright (C) 1997 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, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -# Please email any bugs, comments, and/or additions to this file to: -# bug-gcc@prep.ai.mit.edu - -# Define gcc callbacks for dg.exp. - -load_lib dg.exp - -proc gcc-dg-test { prog do_what extra_tool_flags } { - # Set up the compiler flags, based on what we're going to do. - - switch $do_what { - "preprocess" { - set compile_type "preprocess" - set output_file "[file rootname [file tail $prog]].i" - } - "compile" { - set compile_type "assembly" - set output_file "[file rootname [file tail $prog]].s" - } - "assemble" { - set compile_type "object" - set output_file "[file rootname [file tail $prog]].o" - } - "link" { - set compile_type "executable" - set output_file "a.out" - # The following line is needed for targets like the i960 where - # the default output file is b.out. Sigh. - } - "run" { - set compile_type "executable" - # FIXME: "./" is to cope with "." not being in $PATH. - # Should this be handled elsewhere? - # YES. - set output_file "./a.out" - # This is the only place where we care if an executable was - # created or not. If it was, dg.exp will try to run it. - remote_file build delete $output_file; - } - default { - perror "$do_what: not a valid dg-do keyword" - return "" - } - } - set options "" - if { $extra_tool_flags != "" } { - lappend options "additional_flags=$extra_tool_flags" - } - - set comp_output [gcc_target_compile "$prog" "$output_file" "$compile_type" $options]; - - return [list $comp_output $output_file] -} - - -proc gcc-dg-prune { system text } { - set text [prune_gcc_output $text] - - # If we see "region xxx is full" then the testcase is too big for ram. - # This is tricky to deal with in a large testsuite like c-torture so - # deal with it here. Just mark the testcase as unsupported. - if [regexp "(^|\n)\[^\n\]*: region \[^\n\]* is full" $text] { - # The format here is important. See dg.exp. - return "::unsupported::memory full" - } - - return $text -} diff --git a/gcc/testsuite/lib/gcc.exp b/gcc/testsuite/lib/gcc.exp deleted file mode 100755 index e9ad678..0000000 --- a/gcc/testsuite/lib/gcc.exp +++ /dev/null @@ -1,325 +0,0 @@ -# Copyright (C) 1992, 1993, 1994, 1996, 1997, 1999 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, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -# Please email any bugs, comments, and/or additions to this file to: -# bug-gcc@prep.ai.mit.edu - -# This file was written by Rob Savoye (rob@cygnus.com) -# Currently maintained by Doug Evans (dje@cygnus.com) - -# This file is loaded by the tool init file (eg: unix.exp). It provides -# default definitions for gcc_start, etc. and other supporting cast members. - -# These globals are used by gcc_start if no compiler arguments are provided. -# They are also used by the various testsuites to define the environment: -# where to find stdio.h, libc.a, etc. - -# we want to use libgloss so we can get find_gcc. -load_lib libgloss.exp - -# -# GCC_UNDER_TEST is the compiler under test. -# - -# -# default_gcc_version -- extract and print the version number of the compiler -# - -proc default_gcc_version { } { - global GCC_UNDER_TEST - - gcc_init; - - # ignore any arguments after the command - set compiler [lindex $GCC_UNDER_TEST 0] - - if ![is_remote host] { - set compiler_name [which $compiler]; - } else { - set compiler_name $compiler; - } - - # verify that the compiler exists - if { $compiler_name != 0 } then { - set tmp [remote_exec host "$compiler -v"] - set status [lindex $tmp 0]; - set output [lindex $tmp 1]; - regexp "version.*$" $output version - if { $status == 0 && [info exists version] } then { - clone_output "$compiler_name $version\n" - } else { - clone_output "Couldn't determine version of $compiler_name: $output\n" - } - } else { - # compiler does not exist (this should have already been detected) - warning "$compiler does not exist" - } -} - -# -# Call gcc_version. We do it this way so we can override it if needed. -# -proc gcc_version { } { - default_gcc_version; -} - -# -# gcc_init -- called at the start of each .exp script. -# -# There currently isn't much to do, but always using it allows us to -# make some enhancements without having to go back and rewrite the scripts. -# - -set gcc_initialized 0 - -proc gcc_init { args } { - global tmpdir - global libdir - global gluefile wrap_flags - global gcc_initialized - global GCC_UNDER_TEST - global TOOL_EXECUTABLE - - if { $gcc_initialized == 1 } { return; } - - if ![info exists GCC_UNDER_TEST] { - if [info exists TOOL_EXECUTABLE] { - set GCC_UNDER_TEST $TOOL_EXECUTABLE; - } else { - set GCC_UNDER_TEST "[find_gcc]" - } - } - - if ![info exists tmpdir] then { - set tmpdir /tmp - } - if { [target_info needs_status_wrapper]!="" && ![info exists gluefile] } { - set gluefile ${tmpdir}/testglue.o; - set result [build_wrapper $gluefile]; - if { $result != "" } { - set gluefile [lindex $result 0]; - set wrap_flags [lindex $result 1]; - } else { - unset gluefile - } - } -} - -proc gcc_target_compile { source dest type options } { - global tmpdir; - global gluefile wrap_flags; - global GCC_UNDER_TEST - global TOOL_OPTIONS - - if { [target_info needs_status_wrapper]!="" && [info exists gluefile] } { - lappend options "libs=${gluefile}" - lappend options "ldflags=$wrap_flags" - } - - if [target_info exists gcc,stack_size] { - lappend options "additional_flags=-DSTACK_SIZE=[target_info gcc,stack_size]" - } - if [target_info exists gcc,no_trampolines] { - lappend options "additional_flags=-DNO_TRAMPOLINES" - } - if [target_info exists gcc,no_label_values] { - lappend options "additional_flags=-DNO_LABEL_VALUES" - } - if [info exists TOOL_OPTIONS] { - lappend options "additional_flags=$TOOL_OPTIONS" - } - if [target_info exists gcc,no_varargs] { - lappend options "additional_flags=-DNO_VARARGS" - } - if [target_info exists gcc,timeout] { - lappend options "timeout=[target_info gcc,timeout]" - } - lappend options "compiler=$GCC_UNDER_TEST" - return [target_compile $source $dest $type $options] -} - - -# Reports pass/fail for a gcc compilation and returns true/false. -proc gcc_check_compile {testcase option objname gcc_output} { - - set fatal_signal "*cc: Internal compiler error: program*got fatal signal" - - if [string match "$fatal_signal 6" $gcc_output] then { - gcc_fail $testcase "Got Signal 6, $option" - return 0 - } - - if [string match "$fatal_signal 11" $gcc_output] then { - gcc_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 [gcc_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 { - gcc_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]} { - gcc_fail $testcase $option - return 0 - } - - gcc_pass $testcase $option - return 1 -} - - - -# -# gcc_pass -- utility to record a testcase passed -# - -proc gcc_pass { testcase cflags } { - if { "$cflags" == "" } { - pass "$testcase" - } else { - pass "$testcase, $cflags" - } -} - -# -# gcc_fail -- utility to record a testcase failed -# - -proc gcc_fail { testcase cflags } { - if { "$cflags" == "" } { - fail "$testcase" - } else { - fail "$testcase, $cflags" - } -} - -# -# gcc_finish -- called at the end of every .exp script that calls gcc_init -# -# The purpose of this proc is to hide all quirks of the testing environment -# from the testsuites. It also exists to undo anything that gcc_init did -# (that needs undoing). -# - -proc gcc_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 -} - -proc gcc_exit { } { - global gluefile; - - if [info exists gluefile] { - file_on_build delete $gluefile; - unset gluefile; - } -} - -# If this is an older version of dejagnu (without runtest_file_p), -# provide one and assume the old syntax: foo1.exp bar1.c foo2.exp bar2.c. -# This can be deleted 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 - } -} - -# Provide a definition of this if missing (delete after next dejagnu release). - -if { [info procs prune_warnings] == "" } then { - proc prune_warnings { text } { - return $text - } -} - -# Utility used by mike-gcc.exp and c-torture.exp. -# Check the compiler(/assembler/linker) output for text indicating that -# the testcase should be marked as "unsupported". -# -# 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 "" -} - -# Prune messages from gcc that aren't useful. - -proc prune_gcc_output { text } { - #send_user "Before:$text\n" - regsub -all "(^|\n)\[^\n\]*: In (function|method) \[^\n\]*" $text "" text - regsub -all "(^|\n)\[^\n\]*: At top level:\[^\n\]*" $text "" text - - # It would be nice to avoid passing anything to gcc that would cause it to - # issue these messages (since ignoring them seems like a hack on our part), - # but that's too difficult in the general case. For example, sometimes - # you need to use -B to point gcc at crt0.o, but there are some targets - # that don't have crt0.o. - regsub -all "(^|\n)\[^\n\]*file path prefix \[^\n\]* never used" $text "" text - regsub -all "(^|\n)\[^\n\]*linker input file unused since linking not done" $text "" text - - #send_user "After:$text\n" - - return $text -} - diff --git a/gcc/testsuite/lib/mike-gcc.exp b/gcc/testsuite/lib/mike-gcc.exp deleted file mode 100755 index f9c766a..0000000 --- a/gcc/testsuite/lib/mike-gcc.exp +++ /dev/null @@ -1,262 +0,0 @@ -# Copyright (C) 1988, 90, 91, 92, 95, 96, 1997 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, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -# This file was derived from mike-g++.exp written by Mike Stump <mrs@cygnus.com> - -# Please email any bugs, comments, and/or additions to this file to: -# bug-gcc@prep.ai.mit.edu - -# -# mike_cleanup -- remove any files that are created by the testcase -# -proc mike_cleanup { src_code output_file assembly_file } { - remote_file build delete $output_file $assembly_file; -} - -# -# prebase -- sets up a Mike Stump (mrs@cygnus.com) style gcc test -# -proc prebase { } { - global compiler_output - global not_compiler_output - global compiler_result - global not_compiler_result - global program_output - global groups - global run - global actions - global target_regexp - - set compiler_output "^$" - set not_compiler_output ".*Internal compiler error.*" - set compiler_result "" - set not_compiler_result "" - set program_output ".*PASS.*" - set groups {} - set run no - set actions assemble - set target_regexp ".*" -} - -# -# run the test -# -proc postbase { src_code run groups args } { - global verbose - global srcdir - global subdir - global not_compiler_output - global compiler_output - global compiler_result - global not_compiler_result - global program_output - global actions - global target_regexp - global host_triplet - global target_triplet - global tool - global tmpdir - global GCC_UNDER_TEST - global GROUP - - if ![info exists GCC_UNDER_TEST] { - error "No compiler specified for testing." - } - - if ![regexp $target_regexp $target_triplet] { - unsupported $subdir/$src_code - return - } - - if { [llength $args] > 0 } { - set comp_options [lindex $args 0]; - } else { - set comp_options "" - } - - set fail_message $subdir/$src_code - set pass_message $subdir/$src_code - - if [info exists GROUP] { - if {[lsearch $groups $GROUP] == -1} { - return - } - } - - if [string match $run yes] { - set actions run - } - - set output_file "$tmpdir/[file tail [file rootname $src_code]]" - set assembly_file "$output_file" - append assembly_file ".S" - - set compile_type "none" - - case $actions { - compile - { - set compile_type "assembly"; - set output_file $assembly_file; - } - assemble - { - set compile_type "object"; - append output_file ".o"; - } - link - { - set compile_type "executable"; - set output_file "$tmpdir/a.out"; - } - run - { - set compile_type "executable"; - set output_file "$tmpdir/a.out"; - set run yes; - } - default - { - set output_file ""; - set compile_type "none"; - } - } - - set src_file "$srcdir/$subdir/$src_code" - set options "" - lappend options "compiler=$GCC_UNDER_TEST" - - if { $comp_options != "" } { - lappend options "additional_flags=$comp_options" - } - - set comp_output [gcc_target_compile $src_file $output_file $compile_type $options]; - - set pass no - - # Delete things like "ld.so warning" messages. - set comp_output [prune_warnings $comp_output] - - if [regexp -- $not_compiler_output $comp_output] { - if { $verbose > 1 } { - send_user "\nChecking:\n$not_compiler_output\nto make sure it does not match:\n$comp_output\nbut it does.\n\n" - } else { - send_log "\nCompiler output:\n$comp_output\n\n" - } - fail $fail_message - # The framework doesn't like to see any error remnants, - # so remove them. - uplevel { - if [info exists errorInfo] { - unset errorInfo - } - } - mike_cleanup $src_code $output_file $assembly_file - return - } - - # remove any leftover CRs. - regsub -all -- "\r" $comp_output "" comp_output - - regsub -all "(^|\n)\[^\n\]*linker input file unused since linking not done" $comp_output "" comp_output - regsub -all "(^|\n)\[^\n\]*file path prefix \[^\n\]* never used" $comp_output "" comp_output - - set unsupported_message [${tool}_check_unsupported_p $comp_output] - if { $unsupported_message != "" } { - unsupported "$subdir/$src_code: $unsupported_message" - mike_cleanup $src_code $output_file $assembly_file - return - } - - if { $verbose > 1 } { - send_user "\nChecking:\n$compiler_output\nto see if it matches:\n$comp_output\n" - } else { - send_log "\nCompiler output:\n$comp_output\n\n" - } - if [regexp -- $compiler_output $comp_output] { - if { $verbose > 1 } { - send_user "Yes, it matches.\n\n" - } - set pass yes - if [file exists [file rootname [file tail $src_code]].s] { - set fd [open [file rootname [file tail $src_code]].s r] - set dot_s [read $fd] - close $fd - if { $compiler_result != "" } { - verbose "Checking .s file for $compiler_result" 2 - if [regexp -- $compiler_result $dot_s] { - verbose "Yes, it matches." 2 - } else { - verbose "Nope, doesn't match." 2 - verbose $dot_s 4 - set pass no - } - } - if { $not_compiler_result != "" } { - verbose "Checking .s file for not $not_compiler_result" 2 - if ![regexp -- $not_compiler_result $dot_s] { - verbose "Nope, not found (that's good)." 2 - } else { - verbose "Uh oh, it was found." 2 - verbose $dot_s 4 - set pass no - } - } - } - if [string match $run yes] { - set result [gcc_load $output_file] - set status [lindex $result 0]; - set output [lindex $result 1]; - if { $status == -1 } { - mike_cleanup $src_code $output_file $assembly_file; - return; - } - if { $verbose > 1 } { - send_user "Checking:\n$program_output\nto see if it matches:\n$output\n\n" - } - if ![regexp -- $program_output $output] { - set pass no - if { $verbose > 1 } { - send_user "Nope, does not match.\n\n" - } - } else { - if { $verbose > 1 } { - send_user "Yes, it matches.\n\n" - } - } - } - } else { - if { $verbose > 1 } { - send_user "Nope, does not match.\n\n" - } - } - - if [string match $pass "yes"] { - pass $pass_message - } else { - fail $fail_message - } - - # The framework doesn't like to see any error remnants, - # so remove them. - uplevel { - if [info exists errorInfo] { - unset errorInfo - } - } - - mike_cleanup $src_code $output_file $assembly_file -} diff --git a/gcc/testsuite/lib/old-dejagnu.exp b/gcc/testsuite/lib/old-dejagnu.exp deleted file mode 100755 index bfa29b0..0000000 --- a/gcc/testsuite/lib/old-dejagnu.exp +++ /dev/null @@ -1,585 +0,0 @@ -# Copyright (C) 1988, 90, 91, 92, 1994, 1996, 1997 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, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -# Please email any bugs, comments, and/or additions to this file to: -# bug-g++@prep.ai.mit.edu - -# This file was written by Rob Savoye. (rob@cygnus.com) -# With modifications by Mike Stump <mrs@cygnus.com>. - -# These tests come from the original DejaGnu test suite -# developed at Cygnus Support. If this isn't deja gnu, I -# don't know what is. -# -# Language independence is achieved by: -# -# 1) Using global $tool to indicate the language (eg: gcc, g++, etc.). -# This should only be used to look up other objects. We don't want to -# have to add code for each new language that is supported. If this is -# done right, no code needs to be added here for each new language. -# -# 2) Passing compiler options in as arguments. -# -# We require a bit of smarts in our caller to isolate us from the vagaries of -# each language. See old-deja.exp for the g++ example. - -# Useful subroutines. - -# process-option -- Look for and process a test harness option in the testcase. -# -# PROG is the pathname of the testcase. -# OPTION is the string to look for. -# MESSAGE is what to print if $verbose > 1. -# FLAG_NAME is one of ERROR, WARNING, etc. -# PATTERN is ??? - -proc process-option { prog option message flag_name pattern } { - global verbose - - set result "" - - set tmp [grep $prog "$option.*" line] - if ![string match "" $tmp] then { - foreach i $tmp { - #send_user "Found: $i\n" - set xfail_test 0 - set triplet_match 0 - regsub "\\*/$" [string trim $i] "" i - if [regexp "LINE +\[0-9\]+" $i xopt] then { - regsub "LINE" $xopt "" xopt; - regsub "LINE +\[0-9\]+" $i "" i - set i [lreplace $i 0 0 [expr "${xopt}-0"]]; - } - if [regexp "XFAIL( +\[^ \]+-\[^ \]+-\[^ \]+)*" $i xopt] then { - set xfail_test 1 - regsub "XFAIL( +\[^ \]+-\[^ \]+-\[^ \]+)*" $i "" i - regsub "XFAIL" $xopt "" xopt - if ![string match "" [string trim $xopt]] then { - foreach triplet $xopt { - if [istarget $triplet] { - set triplet_match 1; - break; - } - } - } else { - set triplet_match 1 - } - } - set compos [expr [llength $option] + 1] ;# Start of comment, if any - if { $xfail_test && $triplet_match } then { - lappend result [list [lindex $i 0] "X$flag_name" [lrange $i $compos end] "$pattern"] - } else { - lappend result [list [lindex $i 0] "$flag_name" [lrange $i $compos end] "$pattern"] - } - if { $verbose > 1 } then { - if [string match "" [lrange $i $compos end]] then { - send_user "Found $message for line [lindex $i 0]\n" - } else { - send_user "Found $message \"[lrange $i $compos end]\" for line [lindex $i 0]\n" - } - } - } - } - - #send_user "Returning: $result\n" - return $result -} - -# old-dejagnu-init -- set up some statistics collectors -# -# There currently isn't much to do, but always calling it allows us to add -# enhancements without having to update our callers. -# It must be run before calling `old-dejagnu'. - -proc old-dejagnu-init { } { -} - -# old-dejagnu-stat -- print the stats of this run -# -# ??? This is deprecated, and can be removed. - -proc old-dejagnu-stat { } { -} - -# old-dejagnu -- runs an old style DejaGnu test. -# -# Returns 0 if successful, 1 if their were any errors. -# PROG is the full path name of the file to compile. -# -# CFLAGSX is the options to always pass to the compiler. -# -# DEFAULT_CFLAGS are additional options if the testcase has none. -# -# LIBS_VAR is the name of the global variable containing libraries (-lxxx's). -# This is also ignored. -# -# LIBS is any additional libraries to link with. This *cannot* be specified -# with the compiler flags because otherwise gcc will issue, for example, a -# "-lg++ argument not used since linking not done" warning which will screw up -# the test for excess errors. We could ignore such messages instead. -# -# Think of "cflags" here as "compiler flags", not "C compiler flags". - -proc old-dejagnu { compiler prog name cflagsx default_cflags libs } { - global verbose - global tool - global subdir ;# eg: g++.old-dejagnu - global host_triplet - global tmpdir - - set runflag 1 - set execbug_flag 0 - set excessbug_flag 0 - set pattern "" - set text "\[- A-Za-z0-9\.\;\"\_\:\'\`\(\)\!\#\=\+\?\&\*]*" - - if ![info exists tmpdir] then { - set tmpdir "/tmp" - } - -# look for keywords that change the compiler options -# -# There are two types of test, negative and affirmative. Negative -# tests have the keyword of "ERROR - " or "WARNING - " on the line -# expected to produce an error. This is followed by the pattern. If -# the desired error or warning message appears, then the test passes. -# -# Affirmative test can have the following keywords "gets bogus error", -# "causes invalid C code", "invalid assembly code", "causes abort", -# "causes segfault", "causes linker error", "execution test fails". If -# the pattern after the keyword matches, then the test is a failure. -# -# One can specify particular targets for expected failures of the above -# keywords by putting "XFAIL target-triplet" after the keyword. -# -# Example: -# -# void f () -#{ -# int i[2], j; -# A a (int (i[1]), j); // gets bogus error - late parsing XFAIL *-*-* -# A b (int (i[1]), int j); // function -# a.k = 0; // gets bogus error - late parsing XFAIL *-*-* -# b (i, j); -#} -# -# Note also, that one can add a comment with the keyword ("late parsing" -# in the above example). -# -# If any of the tests contain the special pattern "FIXME -" that test is -# not run because it will produce incorrect output. -# -# Testcases can supply special options to the compiler with a line containing -# "Special.*Options: ...", where ".*" can be anything (eg: g++) and "..." are -# the additional options to pass to the compiler. Nothing else may appear -# after the options. IE: for a C testcase -# /* Special Options: -fomit-frame-pointer */ /* Oops! */ -# is wrong, -# /* Special Options: -fomit-frame-pointer */ -# is right. If no such Special Options are found, $default_cflags is used. -# FIXME: Can there be multiple lines of these? -# -# Other keywords: "Build don't link:", "Build don't run:", "Build then link:", -# "Additional sources: <file>.cc ..." - -# $name is now passed in. -# set name "[file tail [file dirname $prog]]/[file tail $prog]" - - set tmp [grep $prog "FIXME -.*"] - if ![string match "" $tmp] then { - foreach i $tmp { - warning "[file tail [file dirname $prog]]/[file tail $prog] [lrange $i 2 end]" - } - return 1 - } - - set tmp [lindex [grep $prog "Special.*Options:.*"] 0] - set cflags "" - - regsub -all "\n\[^\n\]+(\n|$)" $tmp "\n" tmp - set tmp [string trim $tmp] - if ![string match "" $tmp] then { - regsub "^.*Special.*Options:" $tmp "" tmp - lappend cflags "additional_flags=$tmp" - verbose "Adding special options $tmp" 2 - } else { - lappend cflags "additional_flags=$default_cflags" - } - - if { $cflagsx != "" } { - lappend cflags "additional_flags=$cflagsx" - } - - set tmp [lindex [grep $prog "Additional sources: .*"] 0] - regsub -all "\n\[^\n\]+(\n|$)" $tmp "\n" tmp - set tmp [string trim $tmp] - if ![string match "" $tmp] then { - regsub "^.*Additional.*sources:" $tmp "" tmp - regsub -all " " $tmp " [file dirname $prog]/" tmp - lappend cflags "additional_flags=$tmp" - verbose "Adding sources $tmp" - } - - lappend cflags "compiler=$compiler" - - regsub -all "\[./\]" "$name" "-" output; - set output "$tmpdir/$output"; - set compile_type "executable" - - set tmp [lindex [grep $prog "Build don.t link:"] 0] - if ![string match "" $tmp] then { - set compile_type "object" - set runflag 0 - set output "$tmpdir/[file tail [file rootname $prog]].o" - verbose "Will compile $prog to object" 3 - } - - set tmp [lindex [grep $prog "Build then link:"] 0] - if ![string match "" $tmp] then { - set compile_type "object" - set runflag 2 - set final_output "$output" - set output "$tmpdir/[file tail [file rootname $prog]].o" - verbose "Will compile $prog to object, then link it" 3 - } - - set tmp [lindex [grep $prog "Build don.t run:"] 0] - if ![string match "" $tmp] then { - set runflag 0 - verbose "Will compile $prog to binary" 3 - } - - set tmp [grep $prog "Skip if (|not )feature:.*"]; - if { $tmp != "" } { - foreach line $tmp { - if [regexp "Skip if not feature" $line] { - set not 1; - } else { - set not 0; - } - regsub "^.*Skip if (|not )feature:\[ \]*" "$line" "" i; - set is_set 0; - foreach j $i { - if [target_info exists $j] { - set is_set 1; - break; - } - } - if { $is_set != $not } { - untested "$name: Test skipped: ${line}($j set)" - return; - } - } - } - - set tmp [grep $prog "Skip if (|not )target:.*"]; - if { $tmp != "" } { - foreach line $tmp { - if [regexp "Skip if not target:" $line] { - set not 1; - } else { - set not 0; - } - regsub "^.*Skip if (|not )target:\[ \]*" "$line" "" i; - set ist 0; - foreach j $i { - if [istarget $j] { - set ist 1; - break; - } - } - if { $ist != $not } { - untested "$name: Test skipped: ${line}" - return; - } - } - } - - if ![isnative] { - set tmp [lindex [grep $prog "Skip if not native"] 0]; - if { $tmp != "" } { - untested "$name: Test skipped because not native"; - return; - } - } else { - set tmp [lindex [grep $prog "Skip if native"] 0]; - if { $tmp != "" } { - untested "$name: Test skipped because native"; - return; - } - } - - lappend cflags "libs=$libs" - -# -# Look for the other keywords and extract the error messages. -# `message' contains all the things we found. -# ??? We'd like to use lappend below instead of concat, but that doesn't -# work (adds an extra level of nesting to $tmp). -# - - set message "" - - set tmp [process-option $prog "ERROR - " "an error message" ERROR "$text error$text"] - if ![string match "" $tmp] then { - set runflag 0 - set message [concat $message $tmp] - } - - set tmp [process-option $prog "WARNING - " "a warning message" WARNING "warning"] - if ![string match "" $tmp] then { - set runflag 0 - set message [concat $message $tmp] - } - - set tmp [process-option $prog "gets bogus error" "a bogus error" BOGUS $text] - if ![string match "" $tmp] then { - set message [concat $message $tmp] - } - - set tmp [process-option $prog "causes invalid C code" "a bad C translation" BADC $text] - if ![string match "" $tmp] then { - set message [concat $message $tmp] - } - - set tmp [process-option $prog "invalid assembly code" "some invalid assembly code" BADASM $text] - if ![string match "" $tmp] then { - set message [concat $message $tmp] - } - - set tmp [process-option $prog "causes abort" "an abort cause" ABORT $text] - if ![string match "" $tmp] then { - set message [concat $message $tmp] - } - - set tmp [process-option $prog "causes segfault" "a segfault cause" SEGFAULT $text] - if ![string match "" $tmp] then { - set message [concat $message $tmp] - } - - set tmp [process-option $prog "causes linker error" "a linker error" LINKER $text] - if ![string match "" $tmp] then { - set message [concat $message $tmp] - } - - set tmp [process-option $prog "execution test fails" "an execution failure" EXECO $text] - if ![string match "" $tmp] then { - set execbug_flag 1 - set message [concat $message $tmp] - warning "please use execution test - XFAIL *-*-* in $prog instead" - } - - set tmp [process-option $prog "execution test - " "an excess error failure" EXEC $text] - if ![string match "" $tmp] then { - set message [concat $message $tmp] - } - - set tmp [process-option $prog "excess errors test fails" "an excess error failure" EXCESSO $text] - if ![string match "" $tmp] then { - set excessbug_flag 1 - set message [concat $message $tmp] - warning "please use excess errors test - XFAIL *-*-* in $prog instead" - } - - set tmp [process-option $prog "excess errors test - " "an excess error failure" EXCESS $text] - if ![string match "" $tmp] then { - set message [concat $message $tmp] - } - - set expect_crash \ - [process-option $prog "crash test - " "a crash" CRASH $text] - if {$expect_crash != "" - && [lindex [lindex $expect_crash 0] 1] == "XCRASH"} then { - set expect_crash 1 - } else { - set expect_crash 0 - } - -# -# run the compiler and analyze the results -# - - # Since we don't check return status of the compiler, make sure - # we can't run a.out when the compilation fails. - remote_file build delete $output - set comp_output [${tool}_target_compile $prog $output $compile_type $cflags] - if { $runflag == 2 && [file exists $output] } then { - set runflag 0 - set comp_output [concat $comp_output [${tool}_target_compile $output $final_output "executable" $cflags]] - set output $final_output - } - - # Delete things like "ld.so: warning" messages. - set comp_output [prune_warnings $comp_output] - - if [string match "*Internal compiler error*" $comp_output] then { - if $expect_crash then { - setup_xfail "*-*-*" - } - fail "$name caused compiler crash" - remote_file build delete $output - return 1 - } - - #send_user "\nold_dejagnu.exp: comp_output1 = :$comp_output:\n\n" - #send_user "\nold_dejagnu.exp: message = :$message:\n\n" - #send_user "\nold_dejagnu.exp: message length = [llength $message]\n\n" - - set last_line 0 - foreach i $message { - - #send_user "\nold_dejagnu.exp: i = :$i:\n\n" - - # Remove all error messages for the line [lindex $i 0] - # in the source file. If we find any, success! - set line [lindex $i 0] - set pattern [lindex $i 2] - - # Multiple tests one one line don't work, because we remove all - # messages on the line for the first test. So skip later ones. - if { $line == $last_line } { - continue - } - set last_line $line - - if [regsub -all "(^|\n)\[^\n\]+:$line:\[^\n\]*" $comp_output "" comp_output] { - set comp_output [string trimleft $comp_output] - set ok pass - set uhoh fail - } else { - set ok fail - set uhoh pass - } - - case [lindex $i 1] { - "ERROR" { - $ok "$name $pattern (test for errors, line $line)" - } - "XERROR" { - x$ok "$name $pattern (test for errors, line $line)" - } - "WARNING" { - $ok "$name $pattern (test for warnings, line $line)" - } - "XWARNING" { - x$ok "$name $pattern (test for warnings, line $line)" - } - "BOGUS" { - $uhoh "$name $pattern (test for bogus messages, line $line)" - } - "XBOGUS" { - x$uhoh "$name $pattern (test for bogus messages, line $line)" - } - "ABORT" { - $uhoh "$name $pattern (test for compiler aborts, line $line)" - } - "XABORT" { - x$uhoh "$name $pattern (test for compiler aborts, line $line)" - } - "SEGFAULT" { - $uhoh "$name $pattern (test for compiler segfaults, line $line)" - } - "XSEGFAULT" { - x$uhoh "$name $pattern (test for compiler segfaults, line $line)" - } - "LINKER" { - $uhoh "$name $pattern (test for linker problems, line $line)" - } - "XLINKER" { - x$uhoh "$name $pattern (test for linker problems, line $line)" - } - "BADC" { - $uhoh "$name $pattern (test for Bad C code, line $line)" - } - "XBADC" { - x$uhoh "$name $pattern (test for Bad C code, line $line)" - } - "BADASM" { - $uhoh "$name $pattern (test for bad assembler, line $line)" - } - "XBADASM" { - x$uhoh "$name $pattern (test for bad assembler, line $line)" - } - "XEXEC" { - set execbug_flag 1 - } - "XEXCESS" { - set excessbug_flag 1 - } - } - #send_user "\nold_dejagnu.exp: comp_output2= :$comp_output:\n\n" - } - #send_user "\nold_dejagnu.exp: comp_output3 = :$comp_output:\n\n" - - #look to see if this is all thats left, if so, all messages have been handled - #send_user "comp_output: $comp_output\n" - regsub -all "(^|\n)\[^\n\]*: In (function|method) \[^\n\]*" $comp_output "" comp_output - regsub -all "(^|\n)\[^\n\]*: In instantiation of \[^\n\]*" $comp_output "" comp_output - regsub -all "(^|\n)\[^\n\]*: instantiated from \[^\n\]*" $comp_output "" comp_output - regsub -all "(^|\n)\[^\n\]*: At top level:\[^\n\]*" $comp_output "" comp_output - regsub -all "(^|\n)\[^\n\]*file path prefix \[^\n\]* never used" $comp_output "" comp_output - regsub -all "(^|\n)\[^\n\]*linker input file unused since linking not done" $comp_output "" comp_output - regsub -all "(^|\n)collect: re(compiling|linking)\[^\n\]*" $comp_output "" comp_output - - set unsupported_message [${tool}_check_unsupported_p $comp_output] - if { $unsupported_message != "" } { - unsupported "$name: $unsupported_message" - return - } - - # someone forgot to delete the extra lines - regsub -all "\n+" $comp_output "\n" comp_output - regsub "^\n+" $comp_output "" comp_output - #send_user "comp_output: $comp_output\n" - - # excess errors - if $excessbug_flag then { - setup_xfail "*-*-*" - } - if ![string match "" $comp_output] then { - fail "$name (test for excess errors)" - send_log "$comp_output\n" - } else { - pass "$name (test for excess errors)" - } - - # run the executable image - if $runflag then { - set executable $output - if ![file exists $executable] then { - # Since we couldn't run it, we consider it an expected failure, - # so that test cases don't appear to disappear, and reappear. - setup_xfail "*-*-*" - fail "$name $pattern Execution test" - } else { - set status -1 - set result [eval [format "%s_load %s" $tool $executable]] - set status [lindex $result 0]; - set output [lindex $result 1]; - if { $status == "pass" } { - remote_file build delete $executable; - } - if { $execbug_flag || $excessbug_flag } then { - setup_xfail "*-*-*" - } - $status "$name $pattern Execution test" - } - } - - verbose "deleting $output" - remote_file build delete $output - return 0 -} |