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/f-torture.exp | 317 | ||||
| -rwxr-xr-x | gcc/testsuite/lib/g++-dg.exp | 83 | ||||
| -rwxr-xr-x | gcc/testsuite/lib/g++.exp | 235 | ||||
| -rwxr-xr-x | gcc/testsuite/lib/g77.exp | 274 | ||||
| -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-g++.exp | 264 | ||||
| -rwxr-xr-x | gcc/testsuite/lib/mike-g77.exp | 262 | ||||
| -rwxr-xr-x | gcc/testsuite/lib/mike-gcc.exp | 262 | ||||
| -rwxr-xr-x | gcc/testsuite/lib/objc-torture.exp | 316 | ||||
| -rwxr-xr-x | gcc/testsuite/lib/objc.exp | 269 | ||||
| -rwxr-xr-x | gcc/testsuite/lib/old-dejagnu.exp | 585 |
14 files changed, 3923 insertions, 0 deletions
diff --git a/gcc/testsuite/lib/c-torture.exp b/gcc/testsuite/lib/c-torture.exp new file mode 100755 index 0000000..2078a61 --- /dev/null +++ b/gcc/testsuite/lib/c-torture.exp @@ -0,0 +1,282 @@ +# 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 new file mode 100755 index 0000000..bd8c4f6 --- /dev/null +++ b/gcc/testsuite/lib/chill.exp @@ -0,0 +1,365 @@ +# +# 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/f-torture.exp b/gcc/testsuite/lib/f-torture.exp new file mode 100755 index 0000000..6596b6f --- /dev/null +++ b/gcc/testsuite/lib/f-torture.exp @@ -0,0 +1,317 @@ +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998 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] { + # FIXME: We should test -g at least once. + 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 } \ + { -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 + } +} + +# +# f-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 f-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 [g77_target_compile "$src" "$output" object $options]; + + # Set a few common compiler messages. + set fatal_signal "*77*: Internal compiler error: program*got fatal signal" + + if [string match "$fatal_signal 6" $comp_output] then { + g77_fail $testcase "Got Signal 6, $option" + remote_file build delete $output + return + } + + if [string match "$fatal_signal 11" $comp_output] then { + g77_fail $testcase "Got Signal 11, $option" + remote_file build delete $output + return + } + + # We shouldn't get these because of -w, but just in case. + if [string match "*77*:*warning:*" $comp_output] then { + warning "$testcase: (with warnings) $option" + send_log "$comp_output\n" + unresolved "$testcase, $option" + remote_file build delete $output + return + } + + set comp_output [prune_warnings $comp_output] + + set unsupported_message [g77_check_unsupported_p $comp_output] + if { $unsupported_message != "" } { + unsupported "$testcase: $unsupported_message" + remote_file build delete $output + return + } + + # remove any leftover LF/CR to make sure any output is legit + regsub -all -- "\[\r\n\]*" $comp_output "" comp_output + # If any message remains, we fail. + if ![string match "" $comp_output] then { + g77_fail $testcase $option + remote_file build delete $output + return + } + + g77_pass $testcase $option + remote_file build delete $output +} + +# +# f-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 f-torture-execute { src } { + global tmpdir tool srcdir output + + # 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 "do *\[0-9\]"]+[search_for $src "end *do"]] 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]" + } + + foreach option $option_list { + # torture_{compile,execute}_xfail are set by the .x script + # (if present) + if [info exists torture_compile_xfail] { + setup_xfail $torture_compile_xfail + } + remote_file build delete $executable + verbose "Testing $testcase, $option" 1 + + set options "" + lappend options "additional_flags=-w $option" + set comp_output [g77_target_compile "$src" "$executable" executable $options]; + + # Set a few common compiler messages. + set fatal_signal "*77*: Internal compiler error: program*got fatal signal" + + if [string match "$fatal_signal 6" $comp_output] then { + g77_fail $testcase "Got Signal 6, $option" + remote_file build delete $executable + continue + } + + if [string match "$fatal_signal 11" $comp_output] then { + g77_fail $testcase "Got Signal 11, $option" + remote_file build delete $executable + continue + } + + # We shouldn't get these because of -w, but just in case. + if [string match "*77*:*warning:*" $comp_output] then { + warning "$testcase: (with warnings) $option" + send_log "$comp_output\n" + unresolved "$testcase, $option" + remote_file build delete $executable + continue + } + + set comp_output [prune_warnings $comp_output] + + set unsupported_message [g77_check_unsupported_p $comp_output] + + if { $unsupported_message != "" } { + unsupported "$testcase: $unsupported_message" + continue + } elseif ![file exists $executable] { + if ![is3way] { + fail "$testcase compilation, $option" + untested "$testcase execution, $option" + continue + } else { + # FIXME: since we can't test for the existance of a remote + # file without short of doing an remote file list, we assume + # that since we got no output, it must have compiled. + pass "$testcase compilation, $option" + } + } else { + pass "$testcase compilation, $option" + } + + # 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 "integer\*8"]] then { + untested "$testcase execution, $option" + continue + } + } + + if [info exists torture_execute_xfail] { + setup_xfail $torture_execute_xfail + } + + set result [g77_load "$executable" "" ""] + set status [lindex $result 0]; + set output [lindex $result 1]; + if { $status == "pass" } { + remote_file build delete $executable + } + $status "$testcase execution, $option" + } +} + +# +# 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 } { + set lower [string tolower $cur_line] + if [regexp "$pattern" $lower] then { + close $fd + return 1 + } + } + close $fd + return 0 +} + +# +# f-torture -- the f-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 f-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 "do *\[0-9\]"]+[search_for $src "end *do"]] 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 + } + + f-torture-compile $src "$option $options" + } +} diff --git a/gcc/testsuite/lib/g++-dg.exp b/gcc/testsuite/lib/g++-dg.exp new file mode 100755 index 0000000..cad429e --- /dev/null +++ b/gcc/testsuite/lib/g++-dg.exp @@ -0,0 +1,83 @@ +# Copyright (C) 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, Inc., 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 + +# Define g++ callbacks for dg.exp. + +load_lib dg.exp + +proc g++-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 [g++_target_compile "$prog" "$output_file" "$compile_type" $options]; + + return [list $comp_output $output_file] +} + + +proc g++-dg-prune { system 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/g++.exp b/gcc/testsuite/lib/g++.exp new file mode 100755 index 0000000..27b444e --- /dev/null +++ b/gcc/testsuite/lib/g++.exp @@ -0,0 +1,235 @@ +# Copyright (C) 1992, 1993, 1994, 1995, 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) +# Many modifications by Jeffrey Wheat (cassidy@cygnus.com) +# With modifications by Mike Stump <mrs@cygnus.com>. + +# +# g++ support library routines +# + +# +# GXX_UNDER_TEST is the compiler under test. +# + + +set gpp_compile_options "" + +# +# g++_version -- extract and print the version number of the compiler +# +proc g++_version { } { + global GXX_UNDER_TEST + + # ignore any arguments after the command + set compiler [lindex $GXX_UNDER_TEST 0] + + # verify that the compiler exists + if { [is_remote host] || [which $compiler] != 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 { + if [is_remote host] { + clone_output "$compiler $version\n" + } else { + clone_output "[which $compiler] $version\n" + } + } else { + clone_output "Couldn't determine version of [which $compiler]\n" + } + } else { + # compiler does not exist (this should have already been detected) + warning "$compiler does not exist" + } +} + +# +# g++_init -- called at the start of each subdir of tests +# + +proc g++_init { args } { + global subdir + global gpp_initialized + global base_dir + global tmpdir + global libdir + global gluefile wrap_flags; + global objdir srcdir + global ALWAYS_CXXFLAGS + global TOOL_EXECUTABLE TOOL_OPTIONS + global GXX_UNDER_TEST + + if ![info exists GXX_UNDER_TEST] then { + if [info exists TOOL_EXECUTABLE] { + set GXX_UNDER_TEST $TOOL_EXECUTABLE; + } else { + if [is_remote host] { + set GXX_UNDER_TEST [transform c++] + } else { + set GXX_UNDER_TEST [findfile $base_dir/../xgcc "$base_dir/../xgcc -B$base_dir/../" [findfile $base_dir/xgcc "$base_dir/xgcc -B$base_dir/" [transform c++]]] + } + } + } + + # Bleah, nasty. Bad taste. + if [ishost "*-dos-*" ] { + regsub "c\\+\\+" "$GXX_UNDER_TEST" "gcc" GXX_UNDER_TEST + } + + if ![is_remote host] { + if { [which $GXX_UNDER_TEST] == 0 } then { + perror "GXX_UNDER_TEST does not exist" + exit 1 + } + } + if ![info exists tmpdir] { + set tmpdir "/tmp" + } + + if [info exists gluefile] { + unset gluefile + } + + if { [target_info needs_status_wrapper] != "" } { + 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 + } + } + + set ALWAYS_CXXFLAGS "" + + if ![is_remote host] { + lappend ALWAYS_CXXFLAGS "additional_flags=[g++_include_flags]"; + lappend ALWAYS_CXXFLAGS "ldflags=[g++_link_flags]"; + lappend ALWAYS_CXXFLAGS "incdir=$base_dir/../include" + } + + if [info exists TOOL_OPTIONS] { + lappend ALWAYS_CXXFLAGS "additional_flags=$TOOL_OPTIONS"; + } + + verbose -log "ALWAYS_CXXFLAGS set to $ALWAYS_CXXFLAGS" + + verbose "g++ is initialized" 3 +} + + +proc g++_target_compile { source dest type options } { + global tmpdir; + global gpp_compile_options + global gluefile wrap_flags + global ALWAYS_CXXFLAGS; + global GXX_UNDER_TEST; + + if { [target_info needs_status_wrapper] != "" && [info exists gluefile] } { + lappend options "libs=${gluefile}" + lappend options "ldflags=${wrap_flags}" + } + + lappend options "additional_flags=[libio_include_flags]" + lappend options "compiler=$GXX_UNDER_TEST"; + + set options [concat $options $gpp_compile_options] + + set options [concat $options "$ALWAYS_CXXFLAGS"]; + + if { [regexp "(^| )-frepo( |$)" $options] && \ + [regexp "\.o(|bj)$" $dest] } then { + regsub "\.o(|bj)$" $dest ".rpo" rponame + exec rm -f $rponame + } + + return [target_compile $source $dest $type $options] +} + +proc g++_exit { args } { + 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 the 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-g++.exp and old-dejagnu.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 "" +} + +proc ${tool}_option_help { } { + send_user "--additional_options,OPTIONS\t\tUse OPTIONS to compile the testcase files. OPTIONS should be comma-separated." +} + +proc ${tool}_option_proc { option } { + if[regexp "^--additional_options," $option] { + global gpp_compile_options + regsub "--additional_options," $option "" option + foreach x [split $option ","] { + lappend gpp_compile_options "additional_flags=$x" + } + return 1; + } else { + return 0 + } +} diff --git a/gcc/testsuite/lib/g77.exp b/gcc/testsuite/lib/g77.exp new file mode 100755 index 0000000..3b2beb3 --- /dev/null +++ b/gcc/testsuite/lib/g77.exp @@ -0,0 +1,274 @@ +# Copyright (C) 1992, 1993, 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-g77@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 g77_start, etc. and other supporting cast members. + +# These globals are used by g77_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. + +# +# G77_UNDER_TEST is the compiler under test. +# + +# +# default_g77_version -- extract and print the version number of the compiler +# + +proc default_g77_version { } { + global G77_UNDER_TEST + + g77_init; + + # ignore any arguments after the command + set compiler [lindex $G77_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 options "" + + lappend options "additional_flags=-v" + set tmp [g77_target_compile "" "" "none" $options] + regexp "g77 version\[^\n\]*" $tmp version + if { [info exists version] } then { + clone_output "$compiler_name $version\n" + } else { + clone_output "Couldn't determine version of $compiler_name: $tmp\n" + } + } else { + # compiler does not exist (this should have already been detected) + warning "$compiler does not exist" + } +} + +# +# Call g77_version. We do it this way so we can override it if needed. +# +proc g77_version { } { + default_g77_version; +} + +# +# g77_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 g77_initialized 0 + +proc g77_init { args } { + global tmpdir + global libdir + global gluefile wrap_flags + global g77_initialized + global G77_UNDER_TEST + global TOOL_EXECUTABLE + + if { $g77_initialized == 1 } { return; } + + if ![info exists G77_UNDER_TEST] then { + if [info exists TOOL_EXECUTABLE] { + set G77_UNDER_TEST $TOOL_EXECUTABLE; + } else { + set G77_UNDER_TEST [find_g77] + } + } + + 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 g77_target_compile { source dest type options } { + global tmpdir; + global gluefile wrap_flags; + global G77_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 g77,stack_size] { + lappend options "additional_flags=-DSTACK_SIZE=[target_info g77,stack_size]" + } + if [target_info exists g77,no_trampolines] { + lappend options "additional_flags=-DNO_TRAMPOLINES" + } + if [target_info exists g77,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 g77,no_varargs] { + lappend options "additional_flags=-DNO_VARARGS" + } + if ![is_remote host] { + set gccpath "[get_multilibs]" + set libg2c_dir [lookfor_file ${gccpath} libf2c/libg2c.a] + if { $libg2c_dir != "" } { + set libg2c_link_flags "-L[file dirname ${libg2c_dir}]" + lappend options "additional_flags=${libg2c_link_flags}" + } + } + lappend options "compiler=$G77_UNDER_TEST" + return [target_compile $source $dest $type $options] +} + +# +# g77_pass -- utility to record a testcase passed +# + +proc g77_pass { testcase cflags } { + if { "$cflags" == "" } { + pass "$testcase" + } else { + pass "$testcase, $cflags" + } +} + +# +# g77_fail -- utility to record a testcase failed +# + +proc g77_fail { testcase cflags } { + if { "$cflags" == "" } { + fail "$testcase" + } else { + fail "$testcase, $cflags" + } +} + +# +# g77_finish -- called at the end of every .exp script that calls g77_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 g77_init did +# (that needs undoing). +# + +proc g77_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 g77_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 g77 that aren't useful. + +proc prune_g77_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 g77 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 g77 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/gcc-dg.exp b/gcc/testsuite/lib/gcc-dg.exp new file mode 100755 index 0000000..04cb8b7 --- /dev/null +++ b/gcc/testsuite/lib/gcc-dg.exp @@ -0,0 +1,84 @@ +# 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 new file mode 100755 index 0000000..e9ad678 --- /dev/null +++ b/gcc/testsuite/lib/gcc.exp @@ -0,0 +1,325 @@ +# 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-g++.exp b/gcc/testsuite/lib/mike-g++.exp new file mode 100755 index 0000000..10a1d2b --- /dev/null +++ b/gcc/testsuite/lib/mike-g++.exp @@ -0,0 +1,264 @@ +# 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 written by Mike Stump <mrs@cygnus.com> + +# Please email any bugs, comments, and/or additions to this file to: +# bug-g++@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 G++ 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 objdir + global base_dir + + 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 "" + + if { $comp_options != "" } { + lappend options "additional_flags=$comp_options" + } + + if ![ishost "*-dos-*"] { + lappend options "libs=-lstdc++ -lg++" + } else { + lappend options "libs=-lstdcxx -lgxx" + } + + set comp_output [g++_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 [g++_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/mike-g77.exp b/gcc/testsuite/lib/mike-g77.exp new file mode 100755 index 0000000..a3e12d4 --- /dev/null +++ b/gcc/testsuite/lib/mike-g77.exp @@ -0,0 +1,262 @@ +# Copyright (C) 1988, 90, 91, 92, 95, 96, 97, 1998 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: +# fortran@gnu.org + +# +# 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 g77 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 G77_UNDER_TEST + global GROUP + + if ![info exists G77_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=$G77_UNDER_TEST" + + if { $comp_options != "" } { + lappend options "additional_flags=$comp_options" + } + + set comp_output [g77_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 [g77_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/mike-gcc.exp b/gcc/testsuite/lib/mike-gcc.exp new file mode 100755 index 0000000..f9c766a --- /dev/null +++ b/gcc/testsuite/lib/mike-gcc.exp @@ -0,0 +1,262 @@ +# 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/objc-torture.exp b/gcc/testsuite/lib/objc-torture.exp new file mode 100755 index 0000000..5eadd48 --- /dev/null +++ b/gcc/testsuite/lib/objc-torture.exp @@ -0,0 +1,316 @@ +# Copyright (C) 1992, 1993, 1994, 1995, 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-dejagnu.prep.ai.mit.edu + +# 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] { + # FIXME: We should test -g at least once. + set TORTURE_OPTIONS [list { -O }] +} + + +# 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 + } +} + +# +# objc-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 objc-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 [objc_target_compile "$src" "$output" object $options]; + + # Set a few common compiler messages. + set fatal_signal "*77*: Internal compiler error: program*got fatal signal" + + if [string match "$fatal_signal 6" $comp_output] then { + objc_fail $testcase "Got Signal 6, $option" + remote_file build delete $output + return + } + + if [string match "$fatal_signal 11" $comp_output] then { + objc_fail $testcase "Got Signal 11, $option" + remote_file build delete $output + return + } + + # We shouldn't get these because of -w, but just in case. + if [string match "*77*:*warning:*" $comp_output] then { + warning "$testcase: (with warnings) $option" + send_log "$comp_output\n" + unresolved "$testcase, $option" + remote_file build delete $output + return + } + + set comp_output [prune_warnings $comp_output] + + set unsupported_message [objc_check_unsupported_p $comp_output] + if { $unsupported_message != "" } { + unsupported "$testcase: $unsupported_message" + remote_file build delete $output + return + } + + # remove any leftover LF/CR to make sure any output is legit + regsub -all -- "\[\r\n\]*" $comp_output "" comp_output + # If any message remains, we fail. + if ![string match "" $comp_output] then { + objc_fail $testcase $option + remote_file build delete $output + return + } + + objc_pass $testcase $option + remote_file build delete $output +} + +# +# objc-torture-execute -- utility to compile and execute a testcase +# +# SRC is the full pathname of the testcase. +# +# If the testcase has an associated .cexp file, we source that to run the +# test instead. We use .cexp instead of .exp so that the testcase is still +# controlled by the main .exp driver (this is useful when one wants to only +# run the compile.exp tests for example - one need only pass compile.exp to +# dejagnu, and not compile.exp, foo1.exp, foo2.exp, etc.). +# +proc objc-torture-execute { src } { + global tmpdir tool srcdir output + + # Check for alternate driver. + if [file exists [file rootname $src].cexp] { + verbose "Using alternate driver [file rootname [file tail $src]].cexp" 2 + set done_p 0 + catch "set done_p \[source [file rootname $src].cexp\]" + 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 "do *\[0-9\]"]+[search_for $src "end *do"]] 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]" + } + + foreach option $option_list { + # torture_{compile,execute}_xfail are set by the .cexp script + # (if present) + if [info exists torture_compile_xfail] { + setup_xfail $torture_compile_xfail + } + remote_file build delete $executable + verbose "Testing $testcase, $option" 1 + + set options "" + lappend options "additional_flags=-w $option -I${srcdir}/../../libobjc" + set comp_output [objc_target_compile "$src" "$executable" executable $options]; + + # Set a few common compiler messages. + set fatal_signal "*77*: Internal compiler error: program*got fatal signal" + + if [string match "$fatal_signal 6" $comp_output] then { + objc_fail $testcase "Got Signal 6, $option" + remote_file build delete $executable + continue + } + + if [string match "$fatal_signal 11" $comp_output] then { + objc_fail $testcase "Got Signal 11, $option" + remote_file build delete $executable + continue + } + + # We shouldn't get these because of -w, but just in case. + if [string match "*77*:*warning:*" $comp_output] then { + warning "$testcase: (with warnings) $option" + send_log "$comp_output\n" + unresolved "$testcase, $option" + remote_file build delete $executable + continue + } + + set comp_output [prune_warnings $comp_output] + + set unsupported_message [objc_check_unsupported_p $comp_output] + + if { $unsupported_message != "" } { + unsupported "$testcase: $unsupported_message" + continue + } elseif ![file exists $executable] { + if ![is3way] { + fail "$testcase compilation, $option" + untested "$testcase execution, $option" + continue + } else { + # FIXME: since we can't test for the existance of a remote + # file without short of doing an remote file list, we assume + # that since we got no output, it must have compiled. + pass "$testcase compilation, $option" + } + } else { + pass "$testcase compilation, $option" + } + + # 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 "integer\*8"]] then { + untested "$testcase execution, $option" + continue + } + } + + if [info exists torture_execute_xfail] { + setup_xfail $torture_execute_xfail + } + + set result [objc_load "$executable" "" ""] + set status [lindex $result 0]; + set output [lindex $result 1]; + if { $status == "pass" } { + remote_file build delete $executable + } + $status "$testcase execution, $option" + } +} + +# +# 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 } { + set lower [string tolower $cur_line] + if [regexp "$pattern" $lower] then { + close $fd + return 1 + } + } + close $fd + return 0 +} + +# +# objc-torture -- the objc-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 .cexp file, we source that to run the +# test instead. We use .cexp instead of .exp so that the testcase is still +# controlled by the main .exp driver (this is useful when one wants to only +# run the compile.exp tests for example - one need only pass compile.exp to +# dejagnu, and not compile.exp, foo1.exp, foo2.exp, etc.). +# +proc objc-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].cexp] { + verbose "Using alternate driver [file rootname [file tail $src]].cexp" 2 + set done_p 0 + catch "set done_p \[source [file rootname $src].cexp\]" + 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 "do *\[0-9\]"]+[search_for $src "end *do"]] 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 .cexp script (if present) + if [info exists torture_compile_xfail] { + setup_xfail $torture_compile_xfail + } + + objc-torture-compile $src "$option $options" + } +} diff --git a/gcc/testsuite/lib/objc.exp b/gcc/testsuite/lib/objc.exp new file mode 100755 index 0000000..d67ef04 --- /dev/null +++ b/gcc/testsuite/lib/objc.exp @@ -0,0 +1,269 @@ +# Copyright (C) 1992, 1993, 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. + +# 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 objc_start, etc. and other supporting cast members. + +# These globals are used by objc_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. + +# +# OBJC_UNDER_TEST is the compiler under test. +# + +# +# default_objc_version -- extract and print the version number of the compiler +# + +proc default_objc_version { } { + global OBJC_UNDER_TEST + + objc_init; + + # ignore any arguments after the command + set compiler [lindex $OBJC_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 objc_version. We do it this way so we can override it if needed. +# +proc objc_version { } { + default_objc_version; +} + +# +# objc_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 objc_initialized 0 + +proc objc_init { args } { + global tmpdir + global libdir + global gluefile wrap_flags + global objc_initialized + global OBJC_UNDER_TEST + global TOOL_EXECUTABLE + + if { $objc_initialized == 1 } { return; } + + if ![info exists OBJC_UNDER_TEST] then { + if [info exists TOOL_EXECUTABLE] { + set OBJC_UNDER_TEST $TOOL_EXECUTABLE; + } else { + set OBJC_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 objc_target_compile { source dest type options } { + global tmpdir; + global gluefile wrap_flags; + global OBJC_UNDER_TEST + global TOOL_OPTIONS + + lappend options "libs=-lobjc" + if { [target_info needs_status_wrapper]!="" && [info exists gluefile] } { + lappend options "libs=${gluefile}" + lappend options "ldflags=$wrap_flags" + } + + if [target_info exists objc,stack_size] { + lappend options "additional_flags=-DSTACK_SIZE=[target_info objc,stack_size]" + } + if [target_info exists objc,no_trampolines] { + lappend options "additional_flags=-DNO_TRAMPOLINES" + } + if [target_info exists objc,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 objc,no_varargs] { + lappend options "additional_flags=-DNO_VARARGS" + } + set objcpath "[get_multilibs]" + set libobjc_dir [lookfor_file ${objcpath} libobjc/libobjc.a] + if { $libobjc_dir != "" } { + set objc_link_flags "-L[file dirname ${libobjc_dir}]" + lappend options "additional_flags=${objc_link_flags}" + } + lappend options "compiler=$OBJC_UNDER_TEST" + return [target_compile $source $dest $type $options] +} + +# +# objc_pass -- utility to record a testcase passed +# + +proc objc_pass { testcase cflags } { + if { "$cflags" == "" } { + pass "$testcase" + } else { + pass "$testcase, $cflags" + } +} + +# +# objc_fail -- utility to record a testcase failed +# + +proc objc_fail { testcase cflags } { + if { "$cflags" == "" } { + fail "$testcase" + } else { + fail "$testcase, $cflags" + } +} + +# +# objc_finish -- called at the end of every .exp script that calls objc_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 objc_init did +# (that needs undoing). +# + +proc objc_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 objc_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 objc that aren't useful. + +proc prune_objc_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 objc 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 objc 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/old-dejagnu.exp b/gcc/testsuite/lib/old-dejagnu.exp new file mode 100755 index 0000000..bfa29b0 --- /dev/null +++ b/gcc/testsuite/lib/old-dejagnu.exp @@ -0,0 +1,585 @@ +# 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 +} |