2017-08-15 Ben Elliston <bje@gnu.org>
+ * lib/framework.exp (xml_tag): New proc.
+ (log_summary): Use it.
+ (record_test): Likewise.
+
+2017-08-15 Ben Elliston <bje@gnu.org>
+
* lib/framework.exp (open_logs): Set .xml filename correctly.
* runtest.exp: Remove xml_file_name var.
(usage): Update --xml option to not take an argument.
exit $exit_status
}
+# Emit an XML tag, but escape XML special characters in the body.
+proc xml_tag { tag body } {
+ set escapes { < < > > & & \" " ' ' }
+ return <$tag>[string map $escapes $body]</$tag>
+}
+
proc xml_output { message } {
global xml_file
if { $xml_file != "" } {
- puts $xml_file "$message"
+ puts $xml_file $message
}
}
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 " [xml_tag result $x]"
+ xml_output " [xml_tag description $mess]"
+ xml_output " [xml_tag total $val]"
xml_output " </summary>"
}
if { [string length $mess] < 24 } {
set output ""
set output "expect_out(buffer)"
xml_output " <test>"
- xml_output " <input>[string trimright [lindex $rio 0]]</input>"
- xml_output " <output>[string trimright [lindex $rio 1]]</output>"
- xml_output " <result>$type</result>"
- xml_output " <name>$message</name>"
- xml_output " <prms_id>$prms_id</prms_id>"
+ xml_output " [xml_tag input [string trimright [lindex $rio 0]]]"
+ xml_output " [xml_tag output [string trimright [lindex $rio 1]]]"
+ xml_output " [xml_tag result $type]"
+ xml_output " [xml_tag name $message]"
+ xml_output " [xml_tag prms_id $prms_id]"
xml_output " </test>"
}