4 |
# it under the terms of the GNU General Public License as published by |
# it under the terms of the GNU General Public License as published by |
5 |
# the Free Software Foundation; either version 2 of the License, or |
# the Free Software Foundation; either version 2 of the License, or |
6 |
# (at your option) any later version. |
# (at your option) any later version. |
7 |
# |
# |
8 |
# This program is distributed in the hope that it will be useful, |
# This program is distributed in the hope that it will be useful, |
9 |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
10 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
11 |
# GNU General Public License for more details. |
# GNU General Public License for more details. |
12 |
# |
# |
13 |
# You should have received a copy of the GNU General Public License |
# You should have received a copy of the GNU General Public License |
14 |
# along with this program; if not, write to the Free Software |
# along with this program; if not, write to the Free Software |
15 |
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
69 |
global sum_file |
global sum_file |
70 |
global xml_file |
global xml_file |
71 |
global xml |
global xml |
72 |
|
|
73 |
if { ${tool} == "" } { |
if { ${tool} == "" } { |
74 |
set tool testrun |
set tool testrun |
75 |
} |
} |
98 |
global sum_file |
global sum_file |
99 |
global xml |
global xml |
100 |
global xml_file |
global xml_file |
101 |
|
|
102 |
if { $xml } { |
if { $xml } { |
103 |
xml_output "</testsuite>" |
xml_output "</testsuite>" |
104 |
catch "close $xml_file" |
catch "close $xml_file" |
115 |
proc isbuild { pattern } { |
proc isbuild { pattern } { |
116 |
global build_triplet |
global build_triplet |
117 |
global host_triplet |
global host_triplet |
118 |
|
|
119 |
if ![info exists build_triplet] { |
if ![info exists build_triplet] { |
120 |
set build_triplet ${host_triplet} |
set build_triplet ${host_triplet} |
121 |
} |
} |
123 |
return $build_triplet |
return $build_triplet |
124 |
} |
} |
125 |
verbose "Checking pattern \"$pattern\" with $build_triplet" 2 |
verbose "Checking pattern \"$pattern\" with $build_triplet" 2 |
126 |
|
|
127 |
if [string match "$pattern" $build_triplet] { |
if [string match "$pattern" $build_triplet] { |
128 |
return 1 |
return 1 |
129 |
} else { |
} else { |
191 |
proc is3way {} { |
proc is3way {} { |
192 |
global host_triplet |
global host_triplet |
193 |
global build_triplet |
global build_triplet |
194 |
|
|
195 |
if ![info exists build_triplet] { |
if ![info exists build_triplet] { |
196 |
set build_triplet ${host_triplet} |
set build_triplet ${host_triplet} |
197 |
} |
} |
209 |
# |
# |
210 |
proc ishost { pattern } { |
proc ishost { pattern } { |
211 |
global host_triplet |
global host_triplet |
212 |
|
|
213 |
if [string match "" $pattern] { |
if [string match "" $pattern] { |
214 |
return $host_triplet |
return $host_triplet |
215 |
} |
} |
216 |
verbose "Checking pattern \"$pattern\" with $host_triplet" 2 |
verbose "Checking pattern \"$pattern\" with $host_triplet" 2 |
217 |
|
|
218 |
if [string match "$pattern" $host_triplet] { |
if [string match "$pattern" $host_triplet] { |
219 |
return 1 |
return 1 |
220 |
} else { |
} else { |
230 |
# |
# |
231 |
proc istarget { args } { |
proc istarget { args } { |
232 |
global target_triplet |
global target_triplet |
233 |
|
|
234 |
# if no arg, return the config string |
# if no arg, return the config string |
235 |
if [string match "" $args] { |
if [string match "" $args] { |
236 |
if [info exists target_triplet] { |
if [info exists target_triplet] { |
262 |
proc isnative { } { |
proc isnative { } { |
263 |
global target_triplet |
global target_triplet |
264 |
global build_triplet |
global build_triplet |
265 |
|
|
266 |
if [string match $build_triplet $target_triplet] { |
if [string match $build_triplet $target_triplet] { |
267 |
return 1 |
return 1 |
268 |
} |
} |
302 |
proc clone_output { message } { |
proc clone_output { message } { |
303 |
global sum_file |
global sum_file |
304 |
global all_flag |
global all_flag |
305 |
|
|
306 |
if { $sum_file != "" } { |
if { $sum_file != "" } { |
307 |
puts $sum_file "$message" |
puts $sum_file "$message" |
308 |
} |
} |
338 |
# other miscellaneous variables |
# other miscellaneous variables |
339 |
global prms_id |
global prms_id |
340 |
global bug_id |
global bug_id |
341 |
|
|
342 |
# reset them all |
# reset them all |
343 |
set prms_id 0 |
set prms_id 0 |
344 |
set bug_id 0 |
set bug_id 0 |
423 |
incr totlcnt test_counts($x,$which) |
incr totlcnt test_counts($x,$which) |
424 |
} |
} |
425 |
set testcnt test_counts(total,$which) |
set testcnt test_counts(total,$which) |
426 |
|
|
427 |
if { $testcnt>$totlcnt || $testcnt<$totlcnt } { |
if { $testcnt>$totlcnt || $testcnt<$totlcnt } { |
428 |
if { $testcnt > $totlcnt } { |
if { $testcnt > $totlcnt } { |
429 |
set mismatch "unreported [expr $testcnt-$totlcnt]" |
set mismatch "unreported [expr $testcnt-$totlcnt]" |
470 |
global exit_status |
global exit_status |
471 |
global done_list |
global done_list |
472 |
global subdir |
global subdir |
473 |
|
|
474 |
#catch "exec rm -f [glob xgdb core *.x *.o *_soc a.out]" |
#catch "exec rm -f [glob xgdb core *.x *.o *_soc a.out]" |
475 |
#catch "exec rm -f [glob -nocomplain $subdir/*.o $subdir/*.x $subdir/*_soc]" |
#catch "exec rm -f [glob -nocomplain $subdir/*.o $subdir/*.x $subdir/*_soc]" |
476 |
} |
} |
485 |
proc setup_xfail { args } { |
proc setup_xfail { args } { |
486 |
global xfail_flag |
global xfail_flag |
487 |
global xfail_prms |
global xfail_prms |
488 |
|
|
489 |
set xfail_prms 0 |
set xfail_prms 0 |
490 |
set argc [ llength $args ] |
set argc [ llength $args ] |
491 |
for { set i 0 } { $i < $argc } { incr i } { |
for { set i 0 } { $i < $argc } { incr i } { |
492 |
set sub_arg [ lindex $args $i ] |
set sub_arg [ lindex $args $i ] |
493 |
# is a prms number. we assume this is a string with no '-' characters |
# is a prms number. we assume this is a string with no '-' characters |
494 |
if [regexp "^\[^\-\]+$" $sub_arg] { |
if [regexp "^\[^\-\]+$" $sub_arg] { |
495 |
set xfail_prms $sub_arg |
set xfail_prms $sub_arg |
496 |
continue |
continue |
497 |
} |
} |
512 |
# bug id. |
# bug id. |
513 |
# |
# |
514 |
# Multiple target triplet patterns can be specified for targets |
# Multiple target triplet patterns can be specified for targets |
515 |
# for which the test is known to fail. |
# for which the test is known to fail. |
516 |
# |
# |
517 |
# |
# |
518 |
proc setup_kfail { args } { |
proc setup_kfail { args } { |
519 |
global kfail_flag |
global kfail_flag |
520 |
global kfail_prms |
global kfail_prms |
521 |
|
|
522 |
set kfail_prms 0 |
set kfail_prms 0 |
523 |
set argc [ llength $args ] |
set argc [ llength $args ] |
524 |
for { set i 0 } { $i < $argc } { incr i } { |
for { set i 0 } { $i < $argc } { incr i } { |
525 |
set sub_arg [ lindex $args $i ] |
set sub_arg [ lindex $args $i ] |
526 |
# is a prms number. we assume this is a string with no '-' characters |
# is a prms number. we assume this is a string with no '-' characters |
527 |
if [regexp "^\[^\-\]+$" $sub_arg] { |
if [regexp "^\[^\-\]+$" $sub_arg] { |
528 |
set kfail_prms $sub_arg |
set kfail_prms $sub_arg |
529 |
continue |
continue |
530 |
} |
} |
542 |
|
|
543 |
# check to see if a conditional xfail is triggered |
# check to see if a conditional xfail is triggered |
544 |
# message {targets} {include} {exclude} |
# message {targets} {include} {exclude} |
545 |
# |
# |
546 |
# |
# |
547 |
proc check_conditional_xfail { args } { |
proc check_conditional_xfail { args } { |
548 |
global compiler_flags |
global compiler_flags |
565 |
} else { |
} else { |
566 |
set excludes "" |
set excludes "" |
567 |
} |
} |
568 |
|
|
569 |
# loop through all the targets, checking the options for each one |
# loop through all the targets, checking the options for each one |
570 |
verbose "Compiler flags are: $compiler_flags" 2 |
verbose "Compiler flags are: $compiler_flags" 2 |
571 |
|
|
572 |
set incl_hit 0 |
set incl_hit 0 |
573 |
set excl_hit 0 |
set excl_hit 0 |
574 |
foreach targ $target_list { |
foreach targ $target_list { |
577 |
# this is really messy cause each set of options to look for |
# this is really messy cause each set of options to look for |
578 |
# may also be a list. We also want to find each element of the |
# may also be a list. We also want to find each element of the |
579 |
# list, regardless of order to make sure they're found. |
# list, regardless of order to make sure they're found. |
580 |
# So we look for lists in side of lists, and make sure all |
# So we look for lists in side of lists, and make sure all |
581 |
# the elements match before we decide this is legit. |
# the elements match before we decide this is legit. |
582 |
# Se we 'incl_hit' to 1 before the loop so that if the 'includes' |
# Se we 'incl_hit' to 1 before the loop so that if the 'includes' |
583 |
# list is empty, this test will report a hit. (This can be |
# list is empty, this test will report a hit. (This can be |
644 |
proc clear_xfail { args } { |
proc clear_xfail { args } { |
645 |
global xfail_flag |
global xfail_flag |
646 |
global xfail_prms |
global xfail_prms |
647 |
|
|
648 |
set argc [ llength $args ] |
set argc [ llength $args ] |
649 |
for { set i 0 } { $i < $argc } { incr i } { |
for { set i 0 } { $i < $argc } { incr i } { |
650 |
set sub_arg [ lindex $args $i ] |
set sub_arg [ lindex $args $i ] |
666 |
proc clear_kfail { args } { |
proc clear_kfail { args } { |
667 |
global kfail_flag |
global kfail_flag |
668 |
global kfail_prms |
global kfail_prms |
669 |
|
|
670 |
set argc [ llength $args ] |
set argc [ llength $args ] |
671 |
for { set i 0 } { $i < $argc } { incr i } { |
for { set i 0 } { $i < $argc } { incr i } { |
672 |
set sub_arg [ lindex $args $i ] |
set sub_arg [ lindex $args $i ] |
723 |
if [info exists errorInfo] { |
if [info exists errorInfo] { |
724 |
set error $errorInfo |
set error $errorInfo |
725 |
} |
} |
726 |
global expect_out |
global expect_out |
727 |
set rio { "" "" } |
set rio { "" "" } |
728 |
if { [catch { set rio [split $expect_out(buffer) "\n"] } result]} { |
if { [catch { set rio [split $expect_out(buffer) "\n"] } result]} { |
729 |
#do nothing - leave as { "" "" } |
#do nothing - leave as { "" "" } |
835 |
if {[info exists local_record_procs($lowcase_type)]} { |
if {[info exists local_record_procs($lowcase_type)]} { |
836 |
$local_record_procs($lowcase_type) "$message" |
$local_record_procs($lowcase_type) "$message" |
837 |
} |
} |
838 |
|
|
839 |
# Reset these so they're ready for the next test case. We don't reset |
# Reset these so they're ready for the next test case. We don't reset |
840 |
# prms_id or bug_id here. There may be multiple tests for them. Instead |
# prms_id or bug_id here. There may be multiple tests for them. Instead |
841 |
# they are reset in the main loop after each test. It is also the |
# they are reset in the main loop after each test. It is also the |
861 |
} |
} |
862 |
unset compiler_conditional_xfail_data |
unset compiler_conditional_xfail_data |
863 |
} |
} |
864 |
|
|
865 |
if $kfail_flag { |
if $kfail_flag { |
866 |
record_test KPASS $message |
record_test KPASS $message |
867 |
} elseif $xfail_flag { |
} elseif $xfail_flag { |
949 |
# |
# |
950 |
proc warning { args } { |
proc warning { args } { |
951 |
global warncnt |
global warncnt |
952 |
|
|
953 |
if { [llength $args] > 1 } { |
if { [llength $args] > 1 } { |
954 |
set warncnt [lindex $args 1] |
set warncnt [lindex $args 1] |
955 |
} else { |
} else { |
956 |
incr warncnt |
incr warncnt |
957 |
} |
} |
958 |
set message [lindex $args 0] |
set message [lindex $args 0] |
959 |
|
|
960 |
clone_output "WARNING: $message" |
clone_output "WARNING: $message" |
961 |
|
|
962 |
global errorInfo |
global errorInfo |
967 |
|
|
968 |
# |
# |
969 |
# Prints error messages |
# Prints error messages |
970 |
# These are errors from the framework, not from the tools being tested. |
# These are errors from the framework, not from the tools being tested. |
971 |
# It takes a string, and an optional number and returns nothing. |
# It takes a string, and an optional number and returns nothing. |
972 |
# |
# |
973 |
proc perror { args } { |
proc perror { args } { |
979 |
incr errcnt |
incr errcnt |
980 |
} |
} |
981 |
set message [lindex $args 0] |
set message [lindex $args 0] |
982 |
|
|
983 |
clone_output "ERROR: $message" |
clone_output "ERROR: $message" |
984 |
|
|
985 |
global errorInfo |
global errorInfo |