view release on metacpan or  search on metacpan

redland/rasqal/tests/rdql/testsuite/check-rdql  view on Meta::CPAN

    return $str if $str =~ s/^(<.*>)$/uri$1/;

    #return $str if $str =~ s/^_:(.*)$/blank $1/;
    return $str if $str =~ s/^_:(.*)$/blank _/;
  }


  open(OUT, "|sort >result.out")
    or die "$program: Cannot create pipe to result.out - $!\n";

  # Find ResultSet node
  my $resultset_node=undef;
  for my $node (@node_order) {
    my $type=$node_type{$node};
    next if !$type || $type ne "<${rs}ResultSet>";
    $resultset_node=$node;
    last;
  }

  my $count=0;
  for my $node (@{$nodes{$resultset_node}->{$solution_predicate}}) {
    # Get binding nodes
    my(%results);
    for my $binding_node (@{$nodes{$node}->{$binding_predicate}}) {
      my $variable=$nodes{$binding_node}->{$variable_predicate}->[0];
      $variable=~ s/^"(.*)"$/$1/;
      my $value=$nodes{$binding_node}->{$value_predicate}->[0];
      $results{$variable}=toDebug($value);
    }
    my(@defined_vars)=grep(defined $results{$_}, @vars_order);
    print OUT "result: [",join(", ",map {"$_=$results{$_}"} @defined_vars),"]\n";
    $count++;
  }
  close(OUT);

  $cmd="diff -c result.out roqet.out > diff.out";
  my $rc=system($cmd);
  if($rc) {
    warn "$program: $name FAILED\n";
    warn "Failing program was:\n";
    warn "  $roqet_cmd\n";
    warn "Difference is:\n";
    system("cat diff.out");
    warn "$program: Expected $count results\n";
    return 1;
  } else {
    warn "$program: $name OK\n";
    return 0;
  }

}




# Argument handling
my $usage=0;

while(@ARGV && $ARGV[0] =~ /^-(.+)$/) {
  local $_=shift(@ARGV);
  if(/^-d/) {
    $debug=1;
  } elsif (/^-s$/) {
    if(!@ARGV) {
      $usage=1;
      last;
    } else {
      $srcdir=shift @ARGV;
    }
  }
}

$usage=1 if @ARGV >1;

die "USAGE: $program [-d] [-s srcdir] [TEST]\n" if $usage;

my $unique_test=$ARGV[0];

$srcdir.="/" unless $srcdir =~ m%/$%;


my(@failed);
my(@entries);
if(!$unique_test) {
  opendir(DIR, $srcdir) or die "Cannot opendir $srcdir - $!\n";
  @entries=sort(readdir(DIR));
  closedir(DIR);
} else {
  @entries="test-$unique_test";
}

my $result=0;
for my $entry (@entries) {
  my $entry_file=$srcdir.$entry;
  next if -d $entry_file;
  next unless $entry =~ /^test-(.*)$/;

  my $test=$1;
  my $test_file=$srcdir."test-$test";
  my $result_file=$srcdir."result-$test.n3";
  my $rc = run_test($1, $srcdir, $test_file, [], $result_file);
  push(@failed, $test) if $rc;
  $result++ if $rc;
}

unlink "roqet.out", "result.out", "diff.out", "roqet.err"
  unless $unique_test;

warn "$0: FAILED tests: @failed\n"
  if @failed;
exit $result;