old-dejagnu.exp

this is a gcc file, you can download it and learn its usetility, for further detail please look at t

# Copyright (C) 1988, 90, 91, 92, 1994, 1996, 1997, 2000, 2001 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. ([e-mail])
# With modifications by Mike Stump <[e-mail]>.

# 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 ""
    set to_download ""

    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
	if [is_remote host] {
	    lappend cflags "additional_flags=$tmp"
	}
	regsub -all " " $tmp " [file dirname $prog]/" tmp
	if ![is_remote host] {
	    lappend cflags "additional_flags=$tmp"
	}
	set to_download [concat $to_download $tmp]
	verbose "Adding sources $tmp"
    }

    set tmp [lindex [grep $prog "Additional files: .*"] 0]
    regsub -all "\n\[^\n\]+(\n|$)" $tmp "\n" tmp
    set tmp [string trim $tmp]
    if ![string match "" $tmp] then {
	regsub "^.*Additional.*files:" $tmp "" tmp
	regsub -all " " $tmp " [file dirname $prog]/" tmp
	set to_download [concat $to_download $tmp]
	verbose "Downloading files $tmp"
    }

    lappend cflags "compiler=$compiler"

    regsub -all "\[./\]" "$name" "-" output;
    set output "$tmpdir/$output.exe";
    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 {