old-dejagnu.exp

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

	    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
#
    # Download any source or header files we might need.
    if [is_remote host] {
	foreach file $to_download {
	    remote_download host $file
	}
    }

    # 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_gcc_output [prune_warnings $comp_output]]

    if [regexp "\[Ii\]nternal (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"
	}
    } else {
      verbose "deleting $output"
      remote_file build delete $output
    }

    return 0
}