Merge of XML output code from the official DejaGNU site

diff --git a/dejagnu/ChangeLog b/dejagnu/ChangeLog
index cfc0cdf..a2162ad 100644 (file)
--- a/dejagnu/ChangeLog
+++ b/dejagnu/ChangeLog
@@ -57,6 +57,13 @@
         * testsuite/runtest.all/stats-sub.exp: Test kfail and kpass.
         * testsuite/runtest.all/stats.exp: Ditto.
 
+2002-04-25    <Matthew Bemis <bemis@iol.unh.edu>
+
+       * lib/framework.exp: new procs check_xml{}, insertdtd{}, xml_output{},
+       plus a few hooks to xml_output in the other logging procs to produce
+       XML output.
+       * runtest.exp: Add support for the --x option for XML output.
+
 2002-04-25  Nick Clifton  <nickc@cambridge.redhat.com>
 
        * example/calc/configure.in (AM_MAINTAINER_MODE): Add invocation.

diff --git a/dejagnu/baseboards/powerpc-sim.exp b/dejagnu/baseboards/powerpc-sim.exp
index cb45eeb..e52d0b5 100644 (file)
--- a/dejagnu/baseboards/powerpc-sim.exp
+++ b/dejagnu/baseboards/powerpc-sim.exp
@@ -25,5 +25,4 @@ set_board_info ldflags  "-msim [libgloss_link_flags] [newlib_link_flags]"
 set_board_info gdb,nosignals 1;
 
 # Can't call functions from GDB.
-# There is no real technical reason to prevent function calls with PSIM
 # set_board_info gdb,cannot_call_functions 1

diff --git a/dejagnu/lib/framework.exp b/dejagnu/lib/framework.exp
index 233ea20..59133b5 100644 (file)
--- a/dejagnu/lib/framework.exp
+++ b/dejagnu/lib/framework.exp
@@ -32,18 +32,55 @@ proc mail_file { file to subject } {
 }
 
 #
+# Check for xml output flag or environment variable
+#
+proc check_xml { } {
+    global env
+
+    set x "RUNTESTFLAGS"
+    return [format "%s" $env($x)]
+}
+
+#
+# Insert DTD for xml format checking
+#
+proc insertdtd { } {
+    xml_output "<!DOCTYPE testsuite \[
+<!-- testsuite.dtd -->
+<!ELEMENT testsuite (test | summary)+>
+<!ELEMENT test (log, result, name, prms_id )>
+  <!ELEMENT log                        (#PCDATA)>
+  <!ELEMENT result             (#PCDATA)>
+  <!ELEMENT name               (#PCDATA)>
+  <!ELEMENT prms_id            (#PCDATA)>
+  <!ELEMENT summary (result, description, total)>
+  <!ELEMENT description        (#PCDATA)>
+  <!ELEMENT total              (#PCDATA)>
+\]>"
+}
+
+#
 # Open the output logs
 #
 proc open_logs { } {
     global outdir
     global tool
     global sum_file
+    global xml_file
+    global xml
     
     if { ${tool} ==  "" } {
        set tool testrun
     }
     catch "exec rm -f $outdir/$tool.sum"
     set sum_file [open "$outdir/$tool.sum" w]
+    if { $xml } {
+       catch "exec rm -f $outdir/$tool.xml"
+       set xml_file [open "$outdir/$tool.xml" w]
+        xml_output "<?xml version=\"1.0\"?>"
+        insertdtd
+        xml_output "<testsuite>"
+    }
     catch "exec rm -f $outdir/$tool.log"
     log_file -a "$outdir/$tool.log"
     verbose "Opening log files in $outdir"
@@ -58,7 +95,14 @@ proc open_logs { } {
 #
 proc close_logs { } {
     global sum_file
-    
+    global xml
+    global xml_file
+   
+    if { $xml } {
+        xml_output "</testsuite>"
+        catch "close $xml_file"
+    }
+
     catch "close $sum_file"
 }
 
@@ -330,12 +374,22 @@ proc log_and_exit {} {
     remote_close target
     exit $exit_status
 }
+
+proc xml_output { message } {
+    global xml_file
+    if { $xml_file != "" } {
+       puts $xml_file "$message"
+    }
+}
+
 #
 # Print summary of all pass/fail counts
 #
 proc log_summary { args } {
     global tool
     global sum_file
+    global xml_file
+    global xml
     global exit_status
     global mail_logs
     global outdir
@@ -392,6 +446,13 @@ proc log_summary { args } {
        set val $test_counts($x,$which);
        if { $val > 0 } {
            set mess "# of $test_counts($x,name)";
+            if { $xml } {
+                xml_output "  <summary>"
+                xml_output "    <result>$x</result>"
+                xml_output "    <description>$mess</description>"
+                xml_output "    <total>$val</total>"
+                xml_output "  </summary>"
+            }
            if { [string length $mess] < 24 } {
                append mess "\t";
            }
@@ -622,6 +683,7 @@ proc clear_kfail { args } {
 #
 proc record_test { type message args } {
     global exit_status
+    global xml
     global prms_id bug_id
     global xfail_flag xfail_prms
     global kfail_flag kfail_prms
@@ -649,7 +711,24 @@ proc record_test { type message args } {
 
     incr_count $type;
 
-    switch $type {
+    if { $xml } {
+       global errorInfo
+        set error ""
+        if [info exists errorInfo] {
+           set error $errorInfo
+        }
+        global expect_out
+       
+        set output ""
+        xml_output "  <test>"
+        xml_output "    <log>$output</log>"
+        xml_output "    <result>$type</result>"
+        xml_output "    <name>$message</name>"
+        xml_output "    <prms_id>$prms_id</prms_id>"
+        xml_output "  </test>"
+    }
+
+   switch $type {
        PASS {
            if $prms_id {
                set message [concat $message "\t(PRMS $prms_id)"]

diff --git a/dejagnu/runtest.exp b/dejagnu/runtest.exp
index 31bdd42..2b36188 100644 (file)
--- a/dejagnu/runtest.exp
+++ b/dejagnu/runtest.exp
@@ -55,6 +55,8 @@ set kfail_flag  0             ;# indicates that it is a known failure
 set kfail_prms 0               ;# bug id for the description of the known failure 
 set sum_file   ""              ;# name of the file that contains the summary log
 set base_dir   ""              ;# the current working directory
+set xml_file    ""              ;# name of the xml output if requested
+set xml         0               ;# flag for requesting xml
 set logname     ""             ;# the users login name
 set prms_id    0               ;# GNATS prms id number
 set bug_id     0               ;# optional bug id number
@@ -160,6 +162,8 @@ proc verbose { args } {
                set newline 0
            } elseif { [lindex $args $i] == "-log" } {
                set logfile 1
+            } elseif { [lindex $args $i] == "-x" } {
+                set xml 1
            } elseif { [string index [lindex $args $i] 0] == "-" } {
                clone_output "ERROR: verbose: illegal argument: [lindex $args $i]"
                return
@@ -1161,6 +1165,12 @@ for { set i 0 } { $i < $argc } { incr i } {
            continue
         }
 
+        "--x*" {
+            set xml 1
+            verbose "XML logging turned on"
+            continue
+       }
+
        "--he*" {                       # (--help) help text
            usage;
            exit 0