Commit c56c2eb4 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2003-11-29 11:38:04 by szach] added support for print and better test on error conditions

Original author: szach
Date: 2003-11-29 11:38:04+00:00
parent 53549779
#!/usr/bin/perl -w
use strict;
my $testfile = shift || die "testfile?";
my $logfile = shift || die "logfile?";
my $cduce = "../../cduce";
my $failed_tests = "";
unlink $logfile if (-f $logfile);
sub get_root($) {
my ($f) = @_;
open (F, "< $f");
......@@ -9,26 +14,49 @@ sub get_root($) {
return($1);
}
}
die "Can't find root element in schema $f\n";
print "W: can't find root element in schema $f\n";
return(0);
}
foreach my $s (@ARGV) {
if ($s =~ /(.*)\.xsd$/) {
print "Testing $s ...\n";
open(CD, "> test.cd");
my $msg = "Testing $s ...\n";
print $msg;
open (LOG, ">> $logfile");
print LOG "\n", "*" x 80, "\n", $msg, "*" x 80, "\n";
close LOG;
open(CD, "> $testfile");
my $root = get_root($s);
print CD <<EOF;
schema X = \"$s\";;
#print_type X # $root;;
EOF
if ($root) {
print CD <<EOF;
#print_type X # $root;;
EOF
}
if (-f "$1.xml") {
print CD <<EOF;
let x = load_xml "$1.xml";;
validate x with X # $root;;
let y = validate x with X # $root;;
print_xml y;;
EOF
}
close CD;
system "`which cduce` < test.cd";
my $retval = system "$cduce $testfile >> $logfile 2>&1";
if ($? == -1) {
die "Can't execute CDuce (tried $cduce)\n";
} elsif ($? != 0) {
print "E: test failed on $s\n";
$failed_tests .= " $s";
}
} else {
print "Ignoring $s ...\n"
print "W: ignoring $s ...\n"
};
}
if ($failed_tests) {
print STDERR "One or more tests failed :-(\nFailed tests:$failed_tests\n";
print STDERR "See $logfile for details\n";
exit 1;
} else {
exit 0;
}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment