gcc/testsuite/lib/old-dejagnu.exp - gcc - Git at Google

 # 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.

 # 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
 }
	# 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.

	# 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
	}