586 lines
18 KiB
Plaintext
586 lines
18 KiB
Plaintext
# Copyright (C) 1988, 90, 91, 92, 1994, 1996, 1997, 2000 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 [regexp "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 (\[^\n\]*function|method|\[^\n\]*structor) \[^\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|global scope):\[^\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
|
|
}
|