#!/usr/bin/perl -w
use strict;
use File::Basename;

my $testfile = shift || die "testfile?";
my $logfile = shift || die "logfile?";
my $rootdir = dirname($0);
my $cduce = $rootdir . "/../../cduce";
my $failed_tests = "";
my $nbr_tests = 0;
my $nbr_success = 0;
unlink $logfile if (-f $logfile);
sub get_root($) {
  my ($f) = @_;
  open (F, "< $f");
  while (my $l = <F>) {
    if ($l =~ /.*element\s+name\s*=\s*"(\w+)".*/) {
      close F;
      return($1);
    }
  }
  print "W: can't find root element in schema $f\n";
  return(0);
}
foreach my $s (@ARGV) {
  if ($s =~ /(.*)\.xsd$/) {
    my $msg = "Testing $s ...\n";

    $nbr_tests += 1;
    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\";;
EOF
    if ($root) {
      print CD <<EOF;
	#print_type X . $root;;
EOF
    }
    if (-f "$1.xml") {
	if ($1 ne "$rootdir/po2" && $1 ne "$rootdir/regtest/mails_tns"
	    && $1 ne "$rootdir/regtest/model_group") {
	    print CD <<EOF;
	    let x = load_xml "$1.xml";;
	    let y = validate x with X . $root;;
	print_xml y;;
EOF
}
elsif ($1 eq "$rootdir/po2") {
	    print CD <<EOF;
	    let x = load_xml "$1.xml";;
	let _ =
	namespace po = "http://www.example.com/PO1" in
        let y = validate x with X . po:$root in
	print_xml y;;
EOF
}
elsif ($1 eq "$rootdir/regtest/mails_tns") {
	    print CD <<EOF;
	    let x = load_xml "$1.xml";;
	let _ =
	namespace cd = "http://www.cduce.org/2003/tests/mails" in
        let y = validate x with X . cd:$root in
	print_xml y;;
EOF
}
elsif ($1 eq "$rootdir/regtest/model_group") {
	    print CD <<EOF;
	    let x = load_xml "$1.xml";;
let content = match x with <_ ..>cont -> cont;;
        let y = validate content with X . group1;;
EOF
}
    }
    close CD;
    my $retval = system "$cduce $testfile >> $logfile 2>&1";
    if ($? == -1) {
      die "Can't execute CDuce (tried $cduce)\n";
    } elsif (($? != 0 && $1 ne "$rootdir/regtest/simple_type_recursion") ||
	     ($? = 0 && $1 eq "$rootdir/regtest/simple_type_recursion")) {
      print "E: test failed on $s\n";
      $failed_tests .= " $s";
    }
      else {
      $nbr_success += 1;
    }
  } else {
    print "W: ignoring $s ...\n"
  };
}
  print "$nbr_success / $nbr_tests";
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;
}
