|
|
|
@ -31,8 +31,7 @@ proc mail_file { file to subject } { |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Check for xml output flag or environment variable |
|
|
|
# Check for XML output flag or environment variable. |
|
|
|
# |
|
|
|
proc check_xml { } { |
|
|
|
global env |
|
|
|
@ -41,8 +40,7 @@ proc check_xml { } { |
|
|
|
return [format "%s" $env($x)] |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Insert DTD for xml format checking |
|
|
|
# Insert DTD for xml format checking. |
|
|
|
# |
|
|
|
proc insertdtd { } { |
|
|
|
xml_output "<!DOCTYPE testsuite \[ |
|
|
|
@ -60,8 +58,7 @@ proc insertdtd { } { |
|
|
|
\]>" |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Open the output logs |
|
|
|
# Open the output logs. |
|
|
|
# |
|
|
|
proc open_logs { } { |
|
|
|
global outdir |
|
|
|
@ -90,9 +87,7 @@ proc open_logs { } { |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
# |
|
|
|
# Close the output logs |
|
|
|
# Close the output logs. |
|
|
|
# |
|
|
|
proc close_logs { } { |
|
|
|
global sum_file |
|
|
|
@ -107,9 +102,7 @@ proc close_logs { } { |
|
|
|
catch "close $sum_file" |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Check build host triplet for pattern |
|
|
|
# |
|
|
|
# Check build host triplet for PATTERN. |
|
|
|
# With no arguments it returns the triplet string. |
|
|
|
# |
|
|
|
proc isbuild { pattern } { |
|
|
|
@ -131,7 +124,6 @@ proc isbuild { pattern } { |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Is $board remote? Return a non-zero value if so. |
|
|
|
# |
|
|
|
proc is_remote { board } { |
|
|
|
@ -184,7 +176,7 @@ proc is_remote { board } { |
|
|
|
} |
|
|
|
return 1 |
|
|
|
} |
|
|
|
# |
|
|
|
|
|
|
|
# If this is a canadian (3 way) cross. This means the tools are |
|
|
|
# being built with a cross compiler for another host. |
|
|
|
# |
|
|
|
@ -202,9 +194,7 @@ proc is3way {} { |
|
|
|
return 1 |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Check host triplet for pattern |
|
|
|
# |
|
|
|
# Check host triplet for PATTERN. |
|
|
|
# With no arguments it returns the triplet string. |
|
|
|
# |
|
|
|
proc ishost { pattern } { |
|
|
|
@ -222,8 +212,7 @@ proc ishost { pattern } { |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Check target triplet for pattern |
|
|
|
# Check target triplet for pattern. |
|
|
|
# |
|
|
|
# With no arguments it returns the triplet string. |
|
|
|
# Returns 1 if the target looked for, or 0 if not. |
|
|
|
@ -254,9 +243,7 @@ proc istarget { args } { |
|
|
|
return 0 |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Check to see if we're running the tests in a native environment |
|
|
|
# |
|
|
|
# Returns 1 if running native, 0 if on a target. |
|
|
|
# |
|
|
|
proc isnative { } { |
|
|
|
@ -269,7 +256,6 @@ proc isnative { } { |
|
|
|
return 0 |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# unknown -- called by expect if a proc is called that doesn't exist |
|
|
|
# |
|
|
|
proc unknown { args } { |
|
|
|
@ -289,7 +275,6 @@ proc unknown { args } { |
|
|
|
log_and_exit |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Print output to stdout (or stderr) and to log file |
|
|
|
# |
|
|
|
# If the --all flag (-a) option was used then all messages go the the screen. |
|
|
|
@ -328,7 +313,6 @@ proc clone_output { message } { |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Reset a few counters. |
|
|
|
# |
|
|
|
proc reset_vars {} { |
|
|
|
@ -383,8 +367,7 @@ proc xml_output { message } { |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Print summary of all pass/fail counts |
|
|
|
# Print summary of all pass/fail counts. |
|
|
|
# |
|
|
|
proc log_summary { args } { |
|
|
|
global tool |
|
|
|
@ -462,8 +445,7 @@ proc log_summary { args } { |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Close all open files, remove temp file and core files |
|
|
|
# Close all open files, remove temp file and core files. |
|
|
|
# |
|
|
|
proc cleanup {} { |
|
|
|
global sum_file |
|
|
|
@ -475,7 +457,6 @@ proc cleanup {} { |
|
|
|
#catch "exec rm -f [glob -nocomplain $subdir/*.o $subdir/*.x $subdir/*_soc]" |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Setup a flag to control whether a failure is expected or not |
|
|
|
# |
|
|
|
# Multiple target triplet patterns can be specified for targets |
|
|
|
@ -502,9 +483,7 @@ proc setup_xfail { args } { |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
# |
|
|
|
# Setup a flag to control whether it is a known failure |
|
|
|
# Setup a flag to control whether it is a known failure. |
|
|
|
# |
|
|
|
# A bug report ID _MUST_ be specified, and is the first argument. |
|
|
|
# It still must be a string without '-' so we can be sure someone |
|
|
|
@ -514,7 +493,6 @@ proc setup_xfail { args } { |
|
|
|
# Multiple target triplet patterns can be specified for targets |
|
|
|
# for which the test is known to fail. |
|
|
|
# |
|
|
|
# |
|
|
|
proc setup_kfail { args } { |
|
|
|
global kfail_flag |
|
|
|
global kfail_prms |
|
|
|
@ -539,11 +517,9 @@ proc setup_kfail { args } { |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
# check to see if a conditional xfail is triggered |
|
|
|
# Check to see if a conditional xfail is triggered. |
|
|
|
# message {targets} {include} {exclude} |
|
|
|
# |
|
|
|
# |
|
|
|
proc check_conditional_xfail { args } { |
|
|
|
global compiler_flags |
|
|
|
|
|
|
|
@ -638,8 +614,7 @@ proc check_conditional_xfail { args } { |
|
|
|
return 0 |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Clear the xfail flag for a particular target |
|
|
|
# Clear the xfail flag for a particular target. |
|
|
|
# |
|
|
|
proc clear_xfail { args } { |
|
|
|
global xfail_flag |
|
|
|
@ -660,8 +635,7 @@ proc clear_xfail { args } { |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Clear the kfail flag for a particular target |
|
|
|
# Clear the kfail flag for a particular target. |
|
|
|
# |
|
|
|
proc clear_kfail { args } { |
|
|
|
global kfail_flag |
|
|
|
@ -682,9 +656,7 @@ proc clear_kfail { args } { |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Record that a test has passed or failed (perhaps unexpectedly) |
|
|
|
# |
|
|
|
# Record that a test has passed or failed (perhaps unexpectedly). |
|
|
|
# This is an internal procedure, only used in this file. |
|
|
|
# |
|
|
|
proc record_test { type message args } { |
|
|
|
@ -848,8 +820,7 @@ proc record_test { type message args } { |
|
|
|
set kfail_prms 0 |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Record that a test has passed |
|
|
|
# Record that a test has passed. |
|
|
|
# |
|
|
|
proc pass { message } { |
|
|
|
global xfail_flag kfail_flag compiler_conditional_xfail_data |
|
|
|
@ -871,8 +842,7 @@ proc pass { message } { |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Record that a test has failed |
|
|
|
# Record that a test has failed. |
|
|
|
# |
|
|
|
proc fail { message } { |
|
|
|
global xfail_flag kfail_flag compiler_conditional_xfail_data |
|
|
|
@ -894,22 +864,19 @@ proc fail { message } { |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Record that a test that was expected to fail has passed unexpectedly |
|
|
|
# Record that a test that was expected to fail has passed unexpectedly. |
|
|
|
# |
|
|
|
proc xpass { message } { |
|
|
|
record_test XPASS $message |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Record that a test that was expected to fail did indeed fail |
|
|
|
# Record that a test that was expected to fail did indeed fail. |
|
|
|
# |
|
|
|
proc xfail { message } { |
|
|
|
record_test XFAIL $message |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Record that a test for a known bug has passed unexpectedly |
|
|
|
# Record that a test for a known bug has passed unexpectedly. |
|
|
|
# |
|
|
|
proc kpass { bugid message } { |
|
|
|
global kfail_flag kfail_prms |
|
|
|
@ -918,8 +885,7 @@ proc kpass { bugid message } { |
|
|
|
record_test KPASS $message |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Record that a test has failed due to a known bug |
|
|
|
# Record that a test has failed due to a known bug. |
|
|
|
# |
|
|
|
proc kfail { bugid message } { |
|
|
|
global kfail_flag kfail_prms |
|
|
|
@ -928,24 +894,22 @@ proc kfail { bugid message } { |
|
|
|
record_test KFAIL $message |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Set warning threshold |
|
|
|
# Set warning threshold. |
|
|
|
# |
|
|
|
proc set_warning_threshold { threshold } { |
|
|
|
set warning_threshold $threshold |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Get warning threshold |
|
|
|
# Get warning threshold. |
|
|
|
# |
|
|
|
proc get_warning_threshold { } { |
|
|
|
return $warning_threshold |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Prints warning messages |
|
|
|
# These are warnings from the framework, not from the tools being tested. |
|
|
|
# It takes a string, and an optional number and returns nothing. |
|
|
|
# Prints warning messages. |
|
|
|
# These are warnings from the framework, not from the tools being |
|
|
|
# tested. It takes a string, and an optional number and returns |
|
|
|
# nothing. |
|
|
|
# |
|
|
|
proc warning { args } { |
|
|
|
global warncnt |
|
|
|
@ -965,10 +929,10 @@ proc warning { args } { |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Prints error messages |
|
|
|
# These are errors from the framework, not from the tools being tested. |
|
|
|
# It takes a string, and an optional number and returns nothing. |
|
|
|
# Prints error messages. |
|
|
|
# These are errors from the framework, not from the tools being |
|
|
|
# tested. It takes a string, and an optional number and returns |
|
|
|
# nothing. |
|
|
|
# |
|
|
|
proc perror { args } { |
|
|
|
global errcnt |
|
|
|
@ -988,12 +952,11 @@ proc perror { args } { |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
# Prints informational messages. |
|
|
|
# |
|
|
|
# Prints informational messages |
|
|
|
# |
|
|
|
# These are messages from the framework, not from the tools being tested. |
|
|
|
# This means that it is currently illegal to call this proc outside |
|
|
|
# of dejagnu proper. |
|
|
|
# These are messages from the framework, not from the tools being |
|
|
|
# tested. This means that it is currently illegal to call this proc |
|
|
|
# outside of dejagnu proper. |
|
|
|
# |
|
|
|
proc note { message } { |
|
|
|
clone_output "NOTE: $message" |
|
|
|
@ -1006,31 +969,27 @@ proc note { message } { |
|
|
|
#} |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# untested -- mark the test case as untested |
|
|
|
# untested -- mark the test case as untested. |
|
|
|
# |
|
|
|
proc untested { message } { |
|
|
|
record_test UNTESTED $message |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Mark the test case as unresolved |
|
|
|
# Mark the test case as unresolved. |
|
|
|
# |
|
|
|
proc unresolved { message } { |
|
|
|
record_test UNRESOLVED $message |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Mark the test case as unsupported |
|
|
|
# |
|
|
|
# Mark the test case as unsupported. |
|
|
|
# Usually this is used for a test that is missing OS support. |
|
|
|
# |
|
|
|
proc unsupported { message } { |
|
|
|
record_test UNSUPPORTED $message |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Set up the values in the test_counts array (name and initial totals). |
|
|
|
# Set up the values in the test_counts array (name and initial |
|
|
|
# totals). |
|
|
|
# |
|
|
|
proc init_testcounts { } { |
|
|
|
global test_counts test_names |
|
|
|
@ -1059,9 +1018,8 @@ proc init_testcounts { } { |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
|
|
# Increment NAME in the test_counts array; the amount to increment can be |
|
|
|
# is optional (defaults to 1). |
|
|
|
# Increment NAME in the test_counts array; the amount to increment can |
|
|
|
# be is optional (defaults to 1). |
|
|
|
# |
|
|
|
proc incr_count { name args } { |
|
|
|
global test_counts |
|
|
|
@ -1079,11 +1037,8 @@ proc incr_count { name args } { |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
# |
|
|
|
# Create an exp_continue proc if it doesn't exist |
|
|
|
# |
|
|
|
# For compatablity with old versions. |
|
|
|
# Create an exp_continue proc if it doesn't exist. |
|
|
|
# For compatibility with old versions. |
|
|
|
# |
|
|
|
global argv0 |
|
|
|
if ![info exists argv0] { |
|
|
|
|
Ben Elliston
20 years ago