Commit b2ccd972decd2d97e1dbffb75e91407a3392b52d

Authored by Jay Berkenbilt
1 parent 337b9007

update qtest

git-svn-id: svn+q:///qpdf/trunk@640 71b93d88-0707-0410-a8cf-f5a4172ac649
qtest/bin/qtest-driver
... ... @@ -33,7 +33,7 @@ require TestDriver;
33 33  
34 34 if ((@ARGV == 1) && ($ARGV[0] eq '--version'))
35 35 {
36   - print "$whoami version 1.2\n";
  36 + print "$whoami version 1.3\n";
37 37 exit 0;
38 38 }
39 39 if ((@ARGV == 1) && ($ARGV[0] eq '--print-path'))
... ...
qtest/module/TestDriver.pm
... ... @@ -940,8 +940,8 @@ sub runtest
940 940 # $outcome_text is for the human-readable. We need something
941 941 # different for the xml file.
942 942 $testxml->print(" <testcase\n" .
943   - " testid=\"$category $testnum\"\n" .
944   - " description=\"$description\"\n" .
  943 + " testid=\"" . xmlify($category, 1) . " $testnum\"\n" .
  944 + " description=\"" . xmlify($description, 1) . "\"\n" .
945 945 " outcome=\"" .
946 946 (($outcome eq PASS)
947 947 ? ($passed ? "pass" : "unexpected-pass")
... ... @@ -957,7 +957,7 @@ sub runtest
957 957 $testnum, $description);
958 958 my $cwd = getcwd();
959 959 $testlog->print("cwd: $cwd\n");
960   - $testxml->print(" <cwd>$cwd</cwd>\n");
  960 + $testxml->print(" <cwd>" . xmlify($cwd) . "</cwd>\n");
961 961 my $cmd = $in_command;
962 962 if ((defined $cmd) && (ref($cmd) eq 'ARRAY'))
963 963 {
... ... @@ -966,7 +966,7 @@ sub runtest
966 966 if (defined $cmd)
967 967 {
968 968 $testlog->print("command: $cmd\n");
969   - $testxml->print(" <command>$cmd</command>\n");
  969 + $testxml->print(" <command>" . xmlify($cmd) . "</command>\n");
970 970 }
971 971 if (defined $out_file)
972 972 {
... ... @@ -975,7 +975,8 @@ sub runtest
975 975 # real output was original in a file.
976 976 $testlog->print("expected output in $out_file\n");
977 977 $testxml->print(
978   - " <expected-output-file>$out_file</expected-output-file>\n");
  978 + " <expected-output-file>" . xmlify($out_file) .
  979 + "</expected-output-file>\n");
979 980 }
980 981  
981 982 # It would be nice if we could filter out internal calls for
... ... @@ -984,7 +985,7 @@ sub runtest
984 985 $testlog->print(Carp::longmess());
985 986  
986 987 $testxml->print(" <stacktrace>test failure" .
987   - Carp::longmess() .
  988 + xmlify(Carp::longmess()) .
988 989 "</stacktrace>\n");
989 990  
990 991 if (! $status_match)
... ... @@ -1014,7 +1015,7 @@ sub runtest
1014 1015 {
1015 1016 $testlog->print("\n");
1016 1017 }
1017   - $testxml->print("regexp: " . $out_regexp);
  1018 + $testxml->print("regexp: " . xmlify($out_regexp));
1018 1019 }
1019 1020 else
1020 1021 {
... ... @@ -1169,6 +1170,18 @@ sub write_file_to_fh
1169 1170 }
1170 1171 }
1171 1172  
  1173 +sub xmlify
  1174 +{
  1175 + my ($str, $attr) = @_;
  1176 + $attr = 0 unless defined $attr;
  1177 + $str =~ s/\&/\&amp;/g;
  1178 + $str =~ s/</&lt;/g;
  1179 + $str =~ s/>/&gt;/g;
  1180 + $str =~ s/\"/&quot;/g if $attr;
  1181 + $str =~ s/([\000-\010\013-\037\177-\377])/sprintf("&#x%02x;", ord($1))/ge;
  1182 + $str;
  1183 +}
  1184 +
1172 1185 sub xml_write_file_to_fh
1173 1186 {
1174 1187 my ($file, $out) = @_;
... ... @@ -1178,11 +1191,7 @@ sub xml_write_file_to_fh
1178 1191 binmode $in;
1179 1192 while (defined ($_ = <$in>))
1180 1193 {
1181   - s/\&/\&amp;/g;
1182   - s/</&lt;/g;
1183   - s/>/&gt;/g;
1184   - s/([\000-\011\013-\037\177-\377])/sprintf("&#x%02x;", ord($1))/ge;
1185   - $out->print($_);
  1194 + $out->print(xmlify($_));
1186 1195 }
1187 1196 $in->close();
1188 1197 }
... ...