test.pl 1.39 KB
Newer Older
1
2
#!/usr/bin/perl -w
use strict;
3
4
5
6
7
my $testfile = shift || die "testfile?";
my $logfile = shift || die "logfile?";
my $cduce = "../../cduce";
my $failed_tests = "";
unlink $logfile if (-f $logfile);
8
9
10
11
12
13
14
15
16
sub get_root($) {
  my ($f) = @_;
  open (F, "< $f");
  while (my $l = <F>) {
    if ($l =~ /.*element\s+name\s*=\s*"(\w+)".*/) {
      close F;
      return($1);
    }
  }
17
18
  print "W: can't find root element in schema $f\n";
  return(0);
19
20
21
}
foreach my $s (@ARGV) {
  if ($s =~ /(.*)\.xsd$/) {
22
23
24
25
26
27
    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");
28
29
30
31
    my $root = get_root($s);
    print CD <<EOF;
      schema X = \"$s\";;
EOF
32
33
    if ($root) {
      print CD <<EOF;
34
	#print_type X . $root;;
35
36
EOF
    }
37
38
39
    if (-f "$1.xml") {
      print CD <<EOF;
	let x = load_xml "$1.xml";;
40
	let y = validate x with X . $root;;
41
	print_xml y;;
42
43
44
EOF
    }
    close CD;
45
46
47
48
49
50
51
    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";
    }
52
  } else {
53
    print "W: ignoring $s ...\n"
54
55
  };
}
56
57
58
59
60
61
62
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;
}