/[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.3 by rsavoye, Fri Apr 26 04:22:43 2002 UTC revision 1.4 by rsavoye, Fri Apr 26 05:29:34 2002 UTC
# Line 295  proc unknown { args } { Line 295  proc unknown { args } {
295  # Without this, all messages that start with a keyword are written only to the  # Without this, all messages that start with a keyword are written only to the
296  # detail log file.  All messages that go to the screen will also appear in the  # detail log file.  All messages that go to the screen will also appear in the
297  # detail log.  This should only be used by the framework itself using pass,  # detail log.  This should only be used by the framework itself using pass,
298  # fail, xpass, xfail, warning, perror, note, untested, unresolved, or  # fail, xpass, xfail, kpass, kfail, warning, perror, note, untested, unresolved,
299  # unsupported procedures.  # or unsupported procedures.
300  #  #
301  proc clone_output { message } {  proc clone_output { message } {
302      global sum_file      global sum_file
# Line 308  proc clone_output { message } { Line 308  proc clone_output { message } {
308    
309      regsub "^\[ \t\]*(\[^ \t\]+).*$" "$message" "\\1" firstword;      regsub "^\[ \t\]*(\[^ \t\]+).*$" "$message" "\\1" firstword;
310      case "$firstword" in {      case "$firstword" in {
311          {"PASS:" "XFAIL:" "UNRESOLVED:" "UNSUPPORTED:" "UNTESTED:"} {          {"PASS:" "XFAIL:" "KFAIL:" "UNRESOLVED:" "UNSUPPORTED:" "UNTESTED:"} {
312              if $all_flag {              if $all_flag {
313                  send_user "$message\n"                  send_user "$message\n"
314                  return "$message"                  return "$message"
# Line 418  proc log_summary { args } { Line 418  proc log_summary { args } {
418          if { $testcnt > 0 } {          if { $testcnt > 0 } {
419              set totlcnt 0;              set totlcnt 0;
420              # total all the testcases reported              # total all the testcases reported
421              foreach x { FAIL PASS XFAIL XPASS UNTESTED UNRESOLVED UNSUPPORTED } {              foreach x { FAIL PASS XFAIL KFAIL XPASS KPASS UNTESTED UNRESOLVED UNSUPPORTED } {
422                  incr totlcnt test_counts($x,$which);                  incr totlcnt test_counts($x,$which);
423              }              }
424              set testcnt test_counts(total,$which);              set testcnt test_counts(total,$which);
# Line 442  proc log_summary { args } { Line 442  proc log_summary { args } {
442              }              }
443          }          }
444      }      }
445      foreach x { PASS FAIL XPASS XFAIL UNRESOLVED UNTESTED UNSUPPORTED } {      foreach x { PASS FAIL XPASS XFAIL KPASS KFAIL UNRESOLVED UNTESTED UNSUPPORTED } {
446          set val $test_counts($x,$which);          set val $test_counts($x,$which);
447          if { $val > 0 } {          if { $val > 0 } {
448              set mess "# of $test_counts($x,name)";              set mess "# of $test_counts($x,name)";
# Line 502  proc setup_xfail { args } { Line 502  proc setup_xfail { args } {
502  }  }
503    
504    
505    #
506    # Setup a flag to control whether it is a known failure
507    #
508    # A bug report ID _MUST_ be specified, and is the first argument.
509    # It still must be a string without '-' so we can be sure someone
510    # did not just forget it and we end-up using a taget triple as
511    # bug id.
512    #
513    # Multiple target triplet patterns can be specified for targets
514    # for which the test is known to fail.  
515    #
516    #
517    proc setup_kfail { args } {
518        global kfail_flag
519        global kfail_prms
520        
521        set kfail_prms 0
522        set argc [ llength $args ]
523        for { set i 0 } { $i < $argc } { incr i } {
524            set sub_arg [ lindex $args $i ]
525            # is a prms number. we assume this is a string with no '-' characters
526            if [regexp "^\[^\-\]+$" $sub_arg] {
527                set kfail_prms $sub_arg
528                continue
529            }
530            if [istarget $sub_arg] {
531                set kfail_flag 1
532                continue
533            }
534        }
535    
536        if {$kfail_prms == 0} {
537            perror "Attempt to set a kfail without specifying bug tracking id"
538        }
539    }
540    
541    
542  # check to see if a conditional xfail is triggered  # check to see if a conditional xfail is triggered
543  #       message {targets} {include} {exclude}  #       message {targets} {include} {exclude}
544  #                #              
# Line 618  proc clear_xfail { args } { Line 655  proc clear_xfail { args } {
655  }  }
656    
657  #  #
658    # Clear the kfail flag for a particular target
659    #
660    proc clear_kfail { args } {
661        global kfail_flag
662        global kfail_prms
663        
664        set argc [ llength $args ]
665        for { set i 0 } { $i < $argc } { incr i } {
666            set sub_arg [ lindex $args $i ]
667            case $sub_arg in {
668                "*-*-*" {                   # is a configuration triplet
669                    if [istarget $sub_arg] {
670                        set kfail_flag 0
671                        set kfail_prms 0
672                    }
673                    continue
674                }
675            }
676        }
677    }
678    
679    #
680  # Record that a test has passed or failed (perhaps unexpectedly)  # Record that a test has passed or failed (perhaps unexpectedly)
681  #  #
682  # This is an internal procedure, only used in this file.  # This is an internal procedure, only used in this file.
# Line 627  proc record_test { type message args } { Line 686  proc record_test { type message args } {
686      global xml      global xml
687      global prms_id bug_id      global prms_id bug_id
688      global xfail_flag xfail_prms      global xfail_flag xfail_prms
689        global kfail_flag kfail_prms
690      global errcnt warncnt      global errcnt warncnt
691      global warning_threshold perror_threshold      global warning_threshold perror_threshold
692      global pf_prefix      global pf_prefix
# Line 691  proc record_test { type message args } { Line 751  proc record_test { type message args } {
751                  set message [concat $message "\t(PRMS $xfail_prms)"]                  set message [concat $message "\t(PRMS $xfail_prms)"]
752              }              }
753          }          }
754            KPASS {
755                set exit_status 1
756                if { $kfail_prms != 0 } {
757                    set message [concat $message "\t(PRMS $kfail_prms)"]
758                }
759            }
760            KFAIL {
761                if { $kfail_prms != 0 } {
762                    set message [concat $message "\t(PRMS: $kfail_prms)"]
763                }
764            }
765          UNTESTED {          UNTESTED {
766              # The only reason we look at the xfail stuff is to pick up              # The only reason we look at the xfail/kfail stuff is to pick up
767              # `xfail_prms'.              # `xfail_prms'.
768              if { $xfail_flag && $xfail_prms != 0 } {              if { $kfail_flag && $kfail_prms != 0 } {
769                    set message [concat $message "\t(PRMS $kfail_prms)"]
770                } elseif { $xfail_flag && $xfail_prms != 0 } {
771                  set message [concat $message "\t(PRMS $xfail_prms)"]                  set message [concat $message "\t(PRMS $xfail_prms)"]
772              } elseif $prms_id {              } elseif $prms_id {
773                  set message [concat $message "\t(PRMS $prms_id)"]                  set message [concat $message "\t(PRMS $prms_id)"]
# Line 702  proc record_test { type message args } { Line 775  proc record_test { type message args } {
775          }          }
776          UNRESOLVED {          UNRESOLVED {
777              set exit_status 1              set exit_status 1
778              # The only reason we look at the xfail stuff is to pick up              # The only reason we look at the xfail/kfail stuff is to pick up
779              # `xfail_prms'.              # `xfail_prms'.
780              if { $xfail_flag && $xfail_prms != 0 } {              if { $kfail_flag && $kfail_prms != 0 } {
781                    set message [concat $message "\t(PRMS $kfail_prms)"]
782                } elseif { $xfail_flag && $xfail_prms != 0 } {
783                  set message [concat $message "\t(PRMS $xfail_prms)"]                  set message [concat $message "\t(PRMS $xfail_prms)"]
784              } elseif $prms_id {              } elseif $prms_id {
785                  set message [concat $message "\t(PRMS $prms_id)"]                  set message [concat $message "\t(PRMS $prms_id)"]
786              }              }
787          }          }
788          UNSUPPORTED {          UNSUPPORTED {
789              # The only reason we look at the xfail stuff is to pick up              # The only reason we look at the xfail/kfail stuff is to pick up
790              # `xfail_prms'.              # `xfail_prms'.
791              if { $xfail_flag && $xfail_prms != 0 } {              if { $kfail_flag && $kfail_prms != 0 } {
792                    set message [concat $message "\t(PRMS $kfail_prms)"]
793                } elseif { $xfail_flag && $xfail_prms != 0 } {
794                  set message [concat $message "\t(PRMS $xfail_prms)"]                  set message [concat $message "\t(PRMS $xfail_prms)"]
795              } elseif $prms_id {              } elseif $prms_id {
796                  set message [concat $message "\t(PRMS $prms_id)"]                  set message [concat $message "\t(PRMS $prms_id)"]
# Line 754  proc record_test { type message args } { Line 831  proc record_test { type message args } {
831      set warncnt 0      set warncnt 0
832      set errcnt 0      set errcnt 0
833      set xfail_flag 0      set xfail_flag 0
834        set kfail_flag 0
835      set xfail_prms 0      set xfail_prms 0
836        set kfail_prms 0
837  }  }
838    
839  #  #
840  # Record that a test has passed  # Record that a test has passed
841  #  #
842  proc pass { message } {  proc pass { message } {
843      global xfail_flag compiler_conditional_xfail_data      global xfail_flag kfail_flag compiler_conditional_xfail_data
844    
845      # if we have a conditional xfail setup, then see if our compiler flags match      # if we have a conditional xfail setup, then see if our compiler flags match
846      if [ info exists compiler_conditional_xfail_data ] {      if [ info exists compiler_conditional_xfail_data ] {
# Line 771  proc pass { message } { Line 850  proc pass { message } {
850          unset compiler_conditional_xfail_data          unset compiler_conditional_xfail_data
851      }      }
852            
853      if $xfail_flag {      if $kfail_flag {
854            record_test KPASS $message
855        } elseif $xfail_flag {
856          record_test XPASS $message          record_test XPASS $message
857      } else {      } else {
858          record_test PASS $message          record_test PASS $message
# Line 782  proc pass { message } { Line 863  proc pass { message } {
863  # Record that a test has failed  # Record that a test has failed
864  #  #
865  proc fail { message } {  proc fail { message } {
866      global xfail_flag compiler_conditional_xfail_data      global xfail_flag kfail_flag compiler_conditional_xfail_data
867    
868      # if we have a conditional xfail setup, then see if our compiler flags match      # if we have a conditional xfail setup, then see if our compiler flags match
869      if [ info exists compiler_conditional_xfail_data ] {      if [ info exists compiler_conditional_xfail_data ] {
# Line 792  proc fail { message } { Line 873  proc fail { message } {
873          unset compiler_conditional_xfail_data          unset compiler_conditional_xfail_data
874      }      }
875    
876      if $xfail_flag {      if $kfail_flag {
877            record_test KFAIL $message
878        } elseif $xfail_flag {
879          record_test XFAIL $message          record_test XFAIL $message
880      } else {      } else {
881          record_test FAIL $message          record_test FAIL $message
# Line 800  proc fail { message } { Line 883  proc fail { message } {
883  }  }
884    
885  #  #
886  # Record that a test has passed unexpectedly  # Record that a test that was expected to fail has passed unexpectedly
887  #  #
888  proc xpass { message } {  proc xpass { message } {
889      record_test XPASS $message      record_test XPASS $message
890  }  }
891    
892  #  #
893  # Record that a test has failed unexpectedly  # Record that a test that was expected to fail did indeed fail
894  #  #
895  proc xfail { message } {  proc xfail { message } {
896      record_test XFAIL $message      record_test XFAIL $message
897  }  }
898    
899    #
900    # Record that a test for a known bug has passed unexpectedly
901    #
902    proc kpass { bugid message } {
903        global kfail_flag kfail_prms
904        set kfail_flag 1
905        set kfail_prms $bugid
906        record_test KPASS $message
907    }
908    
909    #
910    # Record that a test has failed due to a known bug
911    #
912    proc kfail { bugid message } {
913        global kfail_flag kfail_prms
914        set kfail_flag 1
915        set kfail_prms $bugid
916        record_test KFAIL $message
917    }
918    
919  #  #
920  # Set warning threshold  # Set warning threshold
# Line 924  proc init_testcounts { } { Line 1027  proc init_testcounts { } {
1027      set test_counts(FAIL,name) "unexpected failures"      set test_counts(FAIL,name) "unexpected failures"
1028      set test_counts(XFAIL,name) "expected failures"      set test_counts(XFAIL,name) "expected failures"
1029      set test_counts(XPASS,name) "unexpected successes"      set test_counts(XPASS,name) "unexpected successes"
1030        set test_counts(KFAIL,name) "known failures"
1031        set test_counts(KPASS,name) "unknown successes"
1032      set test_counts(WARNING,name) "warnings"      set test_counts(WARNING,name) "warnings"
1033      set test_counts(ERROR,name) "errors"      set test_counts(ERROR,name) "errors"
1034      set test_counts(UNSUPPORTED,name) "unsupported tests"      set test_counts(UNSUPPORTED,name) "unsupported tests"

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

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