/[dejagnu]/dejagnu/lib/framework.exp
ViewVC logotype

Diff of /dejagnu/lib/framework.exp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.11 by bje, Thu Aug 7 03:42:43 2003 UTC revision 1.12 by bje, Sat Aug 16 13:08:57 2003 UTC
# Line 4  Line 4 
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.
# Line 69  proc open_logs { } { Line 69  proc open_logs { } {
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      }      }
# Line 98  proc close_logs { } { Line 98  proc close_logs { } {
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"
# Line 115  proc close_logs { } { Line 115  proc close_logs { } {
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      }      }
# Line 123  proc isbuild { pattern } { Line 123  proc isbuild { pattern } {
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 {
# Line 191  proc is_remote { board } { Line 191  proc is_remote { board } {
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      }      }
# Line 209  proc is3way {} { Line 209  proc is3way {} {
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 {
# Line 230  proc ishost { pattern } { Line 230  proc ishost { pattern } {
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] {
# Line 262  proc istarget { args } { Line 262  proc istarget { args } {
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      }      }
# Line 302  proc unknown { args } { Line 302  proc unknown { args } {
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      }      }
# Line 338  proc reset_vars {} { Line 338  proc reset_vars {} {
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
# Line 423  proc log_summary { args } { Line 423  proc log_summary { args } {
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]"
# Line 470  proc cleanup {} { Line 470  proc cleanup {} {
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  }  }
# Line 485  proc cleanup {} { Line 485  proc cleanup {} {
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          }          }
# Line 512  proc setup_xfail { args } { Line 512  proc setup_xfail { args } {
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          }          }
# Line 542  proc setup_kfail { args } { Line 542  proc setup_kfail { args } {
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
# Line 565  proc check_conditional_xfail { args } { Line 565  proc check_conditional_xfail { args } {
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 {
# Line 577  proc check_conditional_xfail { args } { Line 577  proc check_conditional_xfail { args } {
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
# Line 644  proc check_conditional_xfail { args } { Line 644  proc check_conditional_xfail { args } {
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 ]
# Line 666  proc clear_xfail { args } { Line 666  proc clear_xfail { args } {
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 ]
# Line 723  proc record_test { type message args } { Line 723  proc record_test { type message args } {
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 { "" "" }
# Line 835  proc record_test { type message args } { Line 835  proc record_test { type message args } {
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
# Line 861  proc pass { message } { Line 861  proc pass { message } {
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 {
# Line 949  proc get_warning_threshold { } { Line 949  proc get_warning_threshold { } {
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
# Line 967  proc warning { args } { Line 967  proc warning { args } {
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 } {
# Line 979  proc perror { args } { Line 979  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

Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26