mirror of
https://github.com/cookiengineer/audacity
synced 2025-07-04 06:29:07 +02:00
274 lines
6.7 KiB
Perl
Executable File
274 lines
6.7 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
#
|
|
# check-rdql - Run Rasqal against RDQL testsuite
|
|
#
|
|
# $Id: check-rdql,v 1.1 2008-07-08 10:45:12 larsl Exp $
|
|
#
|
|
# USAGE check-rdql [-d] [-s SRCDIR] [TEST]
|
|
#
|
|
# Copyright (C) 2004-2006, David Beckett http://purl.org/net/dajobe/
|
|
# Copyright (C) 2004-2004, University of Bristol, UK http://www.bristol.ac.uk/
|
|
#
|
|
# This package is Free Software and part of Redland http://librdf.org/
|
|
#
|
|
# It is licensed under the following three licenses as alternatives:
|
|
# 1. GNU Lesser General Public License (LGPL) V2.1 or any newer version
|
|
# 2. GNU General Public License (GPL) V2 or any newer version
|
|
# 3. Apache License, V2.0 or any newer version
|
|
#
|
|
# You may not use this file except in compliance with at least one of
|
|
# the above three licenses.
|
|
#
|
|
# See LICENSE.html or LICENSE.txt at the top of this package for the
|
|
# complete terms and further detail along with the license texts for
|
|
# the licenses in COPYING.LIB, COPYING and LICENSE-2.0.txt respectively.
|
|
#
|
|
#
|
|
# Requires:
|
|
# roqet (from rasqal) compiled in the parent directory
|
|
# rapper (from raptor 1.3.0) in the PATH
|
|
#
|
|
# Depends on a variety of rasqal internal debug print formats
|
|
# and has some bug workarounds - see FIXME.
|
|
#
|
|
|
|
|
|
use strict;
|
|
use File::Basename;
|
|
use Cwd;
|
|
|
|
|
|
my $roqet="roqet";
|
|
my $rapper="rapper";
|
|
|
|
|
|
my $rdf='http://www.w3.org/1999/02/22-rdf-syntax-ns#';
|
|
my $rs='http://jena.hpl.hp.com/2003/03/result-set#';
|
|
my $variable_predicate="<${rs}variable>";
|
|
my $value_predicate="<${rs}value>";
|
|
my $binding_predicate="<${rs}binding>";
|
|
my $solution_predicate="<${rs}solution>";
|
|
|
|
my $program=basename $0;
|
|
my $debug=0;
|
|
my $srcdir='.';
|
|
|
|
$debug=1 if defined $ENV{'RASQAL_DEBUG'};
|
|
|
|
|
|
sub run_test($$$$$) {
|
|
my($name, $dir, $test_file, $data_files_ref, $result_file)=@_;
|
|
my(@data_files)=@$data_files_ref;
|
|
|
|
warn "run_test($name, $dir, $test_file, ",join("; ",@data_files)," $result_file)\n"
|
|
if $debug;
|
|
|
|
die "$program: No such RDQL test suite test $test_file\n"
|
|
unless -r $test_file;
|
|
|
|
|
|
die "$program: No such RDQL result suite test $result_file\n"
|
|
unless -r $result_file;
|
|
|
|
my(@args)=(map "-s $_", @data_files);
|
|
my $args_s=join(" ",@args);
|
|
my $roqet_cmd="$roqet -d debug -i rdql $args_s $test_file 2>roqet.err";
|
|
warn "$program: Running '$roqet_cmd'\n"
|
|
if $debug;
|
|
|
|
my(@vars_order)=();
|
|
open(PIPE, "$roqet_cmd|") or die "$program: Cannot create pipe from '$roqet_cmd' - $!\n";
|
|
open(OUT, "| sort >roqet.out") or die "$program: Cannot create pipe to roqet.out - $!\n";
|
|
while(<PIPE>) {
|
|
chomp;
|
|
if(/^(?:selects|bound variables): \[(.*)\]$/) {
|
|
my $vars=$1;
|
|
$vars =~ s/variable\(([^)]+)\)/$1/g; # ) ]
|
|
$vars =~ s/,//g;
|
|
@vars_order=split(/ /, $vars);
|
|
}
|
|
|
|
s/blank \w+/blank _/g;
|
|
|
|
if (m/^result: \[(.*)\]$/) {
|
|
print OUT "$_\n";
|
|
if(!@vars_order) {
|
|
my $vars=$1;
|
|
$vars =~ s/=uri<[^>]+>//g;
|
|
$vars =~ s/=string\("[^"]+"[^)]*\)//g; # "
|
|
$vars =~ s/=blank _//g;
|
|
$vars =~ s/=NULL//g;
|
|
$vars =~ s/,//g;
|
|
@vars_order=split(/ /, $vars);
|
|
}
|
|
}
|
|
}
|
|
close(PIPE);
|
|
close(OUT);
|
|
|
|
open(ERR, "<roqet.err") or die "$program: Cannot open roqet.err - $!\n";
|
|
my(@errs)=();
|
|
while(<ERR>) {
|
|
chomp;
|
|
push(@errs, "$test_file:$1: $2") if /(\d+) rasqal error - (.*)$/;
|
|
}
|
|
close(ERR);
|
|
if(@errs) {
|
|
warn "$program: $test_file FAILED - query returned errors:\n ".join("\n ",@errs)."\n";
|
|
warn "Failing program was:\n";
|
|
warn " $roqet_cmd\n";
|
|
return 1;
|
|
}
|
|
|
|
my $cmd="$rapper -q -i turtle -o ntriples $result_file";
|
|
|
|
my(@node_order);
|
|
my(%nodes);
|
|
my(%node_type);
|
|
|
|
warn "$program: Opening pipe from '$cmd'\n"
|
|
if $debug;
|
|
open(PIPE, "$cmd |");
|
|
while(<PIPE>) {
|
|
chomp;
|
|
s/\s+\.$//;
|
|
|
|
my($subject, $predicate, $object)=split(/ /, $_, 3);
|
|
push(@node_order, $subject)
|
|
unless exists $nodes{$subject} || exists $node_type{$subject};
|
|
|
|
if ($predicate eq "<${rdf}type>") {
|
|
$node_type{$subject}=$object;
|
|
} else {
|
|
push(@{$nodes{$subject}->{$predicate}}, $object);
|
|
}
|
|
}
|
|
close(PIPE);
|
|
|
|
sub toDebug($) {
|
|
my $str=shift;
|
|
|
|
return undef if !defined $str;
|
|
|
|
return "NULL" if $str eq "<${rs}undefined>";
|
|
|
|
return $str if $str =~ s/^(".*")(@.*)(\^\^<.*>)$/string($1$2$3)/;
|
|
|
|
return $str if $str =~ s/^(".*"\^\^<.*>)$/string($1)/;
|
|
|
|
return $str if $str =~ s/^(".*"@.*)$/string($1)/;
|
|
|
|
return $str if $str =~ s/^(".*")$/string($1)/;
|
|
|
|
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 -u 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;
|