mirror of
https://github.com/cookiengineer/audacity
synced 2025-06-25 08:38:39 +02:00
721 lines
18 KiB
Perl
Executable File
721 lines
18 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
||
#
|
||
# check-sparql - Run Rasqal against W3C DAWG SPARQL testsuite
|
||
#
|
||
# $Id: check-sparql,v 1.1 2008-07-08 10:45:47 larsl Exp $
|
||
#
|
||
# USAGE: check-sparql [options] [TEST]
|
||
#
|
||
# Copyright (C) 2004-2007, David Beckett http://purl.org/net/dajobe/
|
||
# Copyright (C) 2004-2005, 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) in the PATH
|
||
#
|
||
# Depends on a variety of rasqal internal debug print formats
|
||
#
|
||
|
||
|
||
use strict;
|
||
use File::Basename;
|
||
use XML::DOM;
|
||
use Getopt::Long;
|
||
use Pod::Usage;
|
||
use Cwd;
|
||
|
||
my $roqet="roqet";
|
||
my $rasqal_url="http://librdf.org/rasqal/";
|
||
my $rapper="rapper";
|
||
|
||
|
||
my $rdf='http://www.w3.org/1999/02/22-rdf-syntax-ns#';
|
||
my $rs='http://www.w3.org/2001/sw/DataAccess/tests/result-set#';
|
||
my $variable_predicate="<${rs}variable>";
|
||
my $value_predicate="<${rs}value>";
|
||
my $binding_predicate="<${rs}binding>";
|
||
my $solution_predicate="<${rs}solution>";
|
||
my $index_predicate="<${rs}index>";
|
||
|
||
my(@manifest_files)=qw(manifest.ttl manifest.n3);
|
||
my $mf='http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#';
|
||
my $mfx='http://jena.hpl.hp.com/2005/05/test-manifest-extra#';
|
||
my $qt='http://www.w3.org/2001/sw/DataAccess/tests/test-query#';
|
||
my $dawgt='http://www.w3.org/2001/sw/DataAccess/tests/test-dawg#';
|
||
|
||
my $program=basename $0;
|
||
my $debug=0;
|
||
my $srcdir='.';
|
||
|
||
$debug=1 if defined $ENV{'RASQAL_DEBUG'};
|
||
|
||
# plural('result', 's', 2);
|
||
sub plural($$$) {
|
||
my($word,$multiple,$count)=@_;
|
||
return ($count == 1) ? $count." ".$word : $count." ".$word.$multiple;
|
||
}
|
||
|
||
|
||
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 _/;
|
||
}
|
||
|
||
sub read_rdf_results_file($) {
|
||
my($result_file)=@_;
|
||
my(@node_order);
|
||
my(%nodes);
|
||
my(%node_type);
|
||
|
||
my $cmd="$rapper -q -g -o ntriples $result_file";
|
||
|
||
warn "$program: Opening pipe from '$cmd'\n"
|
||
if $debug;
|
||
open(PIPE, "$cmd 2>rapper.err |");
|
||
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);
|
||
|
||
open(ERR, "<rapper.err") or die "$program: Cannot open rapper.err - $!\n";
|
||
my(@errs)=();
|
||
while(<ERR>) {
|
||
chomp;
|
||
push(@errs, "$result_file: $1") if m{rapper: Error - (?:URI \S+) - (.*)$};
|
||
}
|
||
close(ERR);
|
||
if(@errs) {
|
||
warn "$program: parsing '$result_file' FAILED - rapper returned errors:\n ".join("\n ",@errs)."\n";
|
||
warn "Failing program was:\n";
|
||
warn " $cmd\n";
|
||
my $curdir=getcwd;
|
||
my $r=$cmd; $r =~ s,file:[^ ]+/,,g; $r =~ s,$curdir/,,g;
|
||
warn " OR $r\n";
|
||
return undef;
|
||
}
|
||
|
||
unlink "rapper.err";
|
||
|
||
my(%results)=(rows => []);
|
||
|
||
# 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;
|
||
}
|
||
|
||
if(!defined $resultset_node) {
|
||
# No result defined
|
||
return {expect_empty => 1};
|
||
}
|
||
|
||
for my $node (@{$nodes{$resultset_node}->{$solution_predicate}}) {
|
||
# Get binding nodes
|
||
my $row={};
|
||
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];
|
||
$row->{$variable}=toDebug($value);
|
||
}
|
||
|
||
my $row_index=$nodes{$node}->{$index_predicate};
|
||
if(defined $row_index) {
|
||
# Some - but not all - result sets use rs:index to order results
|
||
my $ri=$row_index->[0]; $ri =~ s/^\"(\d+)\".*$/$1/;
|
||
$results{rows}->[$ri-1]=$row;
|
||
} else {
|
||
push(@{$results{rows}}, $row);
|
||
}
|
||
}
|
||
return \%results;
|
||
}
|
||
|
||
|
||
sub read_srx_results_file($) {
|
||
my($result_file)=@_;
|
||
|
||
my(%results)=(rows => []);
|
||
|
||
$result_file =~ s%^file://%%;
|
||
|
||
my $parser = new XML::DOM::Parser;
|
||
my $doc = $parser->parsefile($result_file);
|
||
|
||
for my $result ($doc->getElementsByTagName("result")) {
|
||
next unless ref($result) eq 'XML::DOM::Element';
|
||
my($row)={};
|
||
|
||
warn "Result Element ".$result->getNodeName()."\n"
|
||
if $debug > 1;
|
||
|
||
for my $binding ($result->getChildNodes()) {
|
||
next unless ref($binding) eq 'XML::DOM::Element';
|
||
|
||
my $variable=$binding->getAttribute('name');
|
||
|
||
warn " Binding Element ".$binding->getNodeName()." name=$variable\n"
|
||
if $debug > 1;
|
||
|
||
for my $el ($binding->getChildNodes()) {
|
||
next unless ref($el) eq 'XML::DOM::Element';
|
||
my $el_name=$el->getTagName();
|
||
|
||
warn " Binding sub-element $el_name\n"
|
||
if $debug > 1;
|
||
|
||
my $value;
|
||
if($el_name eq 'uri') {
|
||
my $contents=$el->getFirstChild()->getNodeValue();
|
||
$value="uri<$contents>";
|
||
} elsif($el_name eq 'literal') {
|
||
my $contents=$el->getFirstChild() ? ($el->getFirstChild()->getNodeValue()) : '';
|
||
if(my $datatype=$el->getAttribute('datatype')) {
|
||
$value="string(\"".$contents."\"^^<$datatype>)";
|
||
} elsif(my $language=$el->getAttribute('xml:lang')) {
|
||
$value="string(\"$contents\"\@$language)";
|
||
} else {
|
||
$value="string(\"$contents\")";
|
||
}
|
||
} elsif($el_name eq 'bnode') {
|
||
$value="blank _";
|
||
} else {
|
||
$value='';
|
||
}
|
||
warn " Encoded value: $value\n"
|
||
if $debug > 1;
|
||
$row->{$variable}=$value;
|
||
}
|
||
|
||
} # end for binding
|
||
|
||
push(@{$results{rows}}, $row);
|
||
|
||
} # end for my result
|
||
|
||
return \%results;
|
||
}
|
||
|
||
|
||
sub run_test {
|
||
my($config)=@_;
|
||
my($name,$dir,$test_file,$result_file,$expect_fail)=
|
||
($config->{name}, $config->{dir}, $config->{test_file},
|
||
$config->{result_file}, $config->{expect_fail});
|
||
my($test_uri)=$config->{test_uri};
|
||
my(@data_files)=@{$config->{data_files}};
|
||
my(@named_data_files)=@{$config->{named_data_files}};
|
||
|
||
warn "run_test(\n name : $name\n dir : $dir\n query : $test_file\n data : ",join("; ",@data_files),"\n named data : ",join("; ",@named_data_files),"\n result : ",($result_file||"none"),"\n expect : ",($expect_fail ? "failure":"success"),"\n)\n"
|
||
if $debug;
|
||
|
||
my(@args)=();
|
||
push(@args, (map "-D $_", @data_files)) if @data_files;
|
||
push(@args, (map "-G $_", @named_data_files)) if @named_data_files;
|
||
|
||
push(@args, "-n")
|
||
unless $config->{execute};
|
||
|
||
my $args_s=join(" ",@args);
|
||
my $roqet_tmp='roqet.tmp';
|
||
my $roqet_cmd="$roqet -d debug -i sparql $args_s $test_file 2>roqet.err > $roqet_tmp";
|
||
my $sort="sort";
|
||
|
||
warn "$program: Running '$roqet_cmd'\n"
|
||
if $debug;
|
||
system($roqet_cmd);
|
||
my $rc=$? >>8;
|
||
warn "$program: roqet returned code $rc\n"
|
||
if $debug;
|
||
if($rc) {
|
||
if($expect_fail) {
|
||
warn "$program: '$name' OK (got expected failure)\n";
|
||
return 1;
|
||
}
|
||
|
||
warn "$program: test '$test_file' ($test_uri) FAILED - query command failed (result $rc):\n";
|
||
warn "Failing program was:\n";
|
||
warn " $roqet_cmd\n";
|
||
my $curdir=getcwd;
|
||
my $r=$roqet_cmd; $r =~ s,file:[^ ]+/,,g; $r =~ s,$curdir/,,g;
|
||
warn " OR $r\n";
|
||
system("cat roqet.err");
|
||
unlink $roqet_tmp;
|
||
return 1;
|
||
}
|
||
|
||
open(PIPE, "<$roqet_tmp") or die "$program: Cannot read $roqet_tmp - $!\n";
|
||
|
||
my $sorted=0;
|
||
my $first_result=1;
|
||
my $roqet_results=0;
|
||
my(@vars_order);
|
||
|
||
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/query order conditions:/) {
|
||
$sorted=1;
|
||
$sort=$sorted ? "cat " : "sort ";
|
||
}
|
||
|
||
if (m/^result: \[(.*)\]$/) {
|
||
my $line=$_;
|
||
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);
|
||
}
|
||
$line =~ s/,?\s+\w+=NULL//g;
|
||
$line =~ s/\w+=NULL,\s+//g;
|
||
|
||
if($first_result) {
|
||
open(OUT, "|$sort >roqet.out") or die "$program: Cannot create pipe to roqet.out - $!\n";
|
||
$first_result=0;
|
||
}
|
||
|
||
print OUT "$line\n";
|
||
$roqet_results++;
|
||
}
|
||
}
|
||
close(PIPE);
|
||
unlink $roqet_tmp;
|
||
|
||
if($first_result) {
|
||
open(OUT, ">roqet.out") or die "$program: Cannot create pipe to roqet.out - $!\n";
|
||
}
|
||
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 '$test_file' ($test_uri) FAILED - query returned errors:\n ".join("\n ",@errs)."\n";
|
||
warn "Failing program was:\n";
|
||
warn " $roqet_cmd\n";
|
||
my $curdir=getcwd;
|
||
my $r=$roqet_cmd; $r =~ s,file:[^ ]+/,,g; $r =~ s,$curdir/,,g;
|
||
warn " OR $r\n";
|
||
return 1;
|
||
}
|
||
|
||
my $cmd;
|
||
|
||
my $results={expect_empty => 1};
|
||
|
||
if(defined $result_file) {
|
||
if($result_file =~ /\.srx$/) {
|
||
$results=read_srx_results_file($result_file);
|
||
} else {
|
||
$results=read_rdf_results_file($result_file);
|
||
}
|
||
}
|
||
|
||
if(!defined $results) {
|
||
return 1;
|
||
}
|
||
|
||
if(exists $results->{expect_empty}) {
|
||
warn "$program: '$name' OK (no result)\n";
|
||
return $expect_fail ? 1 : 0;
|
||
}
|
||
|
||
open(OUT, "|$sort >result.out")
|
||
or die "$program: Cannot create pipe to result.out - $!\n";
|
||
|
||
my $count=0;
|
||
for my $row (@{$results->{rows}}) {
|
||
my(@defined_vars)=grep(defined $row->{$_}, @vars_order);
|
||
print OUT "result: [",join(", ",map {"$_=$row->{$_}"} @defined_vars),"]\n";
|
||
$count++;
|
||
}
|
||
close(OUT);
|
||
|
||
$cmd="diff -c result.out roqet.out > diff.out";
|
||
$rc=system($cmd);
|
||
if($rc) {
|
||
warn "$program: '$name' FAILED ($test_uri) \n";
|
||
warn "Failing program was:\n";
|
||
warn " $roqet_cmd\n";
|
||
my $curdir=getcwd;
|
||
my $r=$roqet_cmd; $r =~ s,file:[^ ]+/,,g; $r =~ s,$curdir/,,g;
|
||
warn " OR $r\n";
|
||
warn "Difference is:\n";
|
||
system("cat diff.out");
|
||
warn "$program: Expected ".plural("result","s",$count).", got $roqet_results\n";
|
||
return 1;
|
||
} else {
|
||
warn "$program: '$name' OK\n";
|
||
return 0;
|
||
}
|
||
|
||
}
|
||
|
||
|
||
|
||
|
||
# Argument handling
|
||
my $usage=0;
|
||
my $manifest_file=undef;
|
||
my $earl_report_file=undef;
|
||
|
||
GetOptions(
|
||
'debug|d+' => \$debug, # incremental
|
||
'srcdir|s=s' => \$srcdir,
|
||
'manifest|m=s' => \$manifest_file,
|
||
'earl|e=s' => \$earl_report_file,
|
||
'help|h|?' => \$usage
|
||
) || pod2usage(2);
|
||
|
||
pod2usage(-verbose => 2) if $usage;
|
||
pod2usage("$0: Too many tests given.\n") if (@ARGV > 1);
|
||
|
||
my $unique_test=$ARGV[0];
|
||
|
||
$srcdir.="/" unless $srcdir =~ m%/$%;
|
||
|
||
if(!defined $manifest_file) {
|
||
for my $file (@manifest_files) {
|
||
next unless -r $srcdir.$file;
|
||
$manifest_file=$file;
|
||
}
|
||
}
|
||
die "$program: No manifest file found in $srcdir\n"
|
||
unless defined $manifest_file;
|
||
|
||
|
||
my(%triples);
|
||
my $entries_node;
|
||
my $cmd="$rapper -q -i turtle -o ntriples $srcdir$manifest_file";
|
||
open(MF, "$cmd |")
|
||
or die "Cannot open pipe from '$cmd' - $!\n";
|
||
while(<MF>) {
|
||
chomp;
|
||
s/\s+\.$//;
|
||
my($s,$p,$o)=split(/ /,$_,3);
|
||
die "no p in '$_'\n" unless defined $p;
|
||
die "no o in '$_'\n" unless defined $o;
|
||
push(@{$triples{$s}->{$p}}, $o);
|
||
$entries_node=$o if $p eq "<${mf}entries>";
|
||
}
|
||
close(MF);
|
||
|
||
warn "Entries node is '$entries_node'\n"
|
||
if $debug > 1;
|
||
my $list_node=$entries_node;
|
||
|
||
my(@tests);
|
||
while($list_node) {
|
||
warn "List node is '$list_node'\n"
|
||
if $debug > 1;
|
||
|
||
my $entry_node=$triples{$list_node}->{"<${rdf}first>"}->[0];
|
||
|
||
warn "Entry node is '$entry_node'\n"
|
||
if $debug > 1;
|
||
|
||
my $name=$triples{$entry_node}->{"<${mf}name>"}->[0];
|
||
$name =~ s/^\"(.*)\"$/$1/;
|
||
|
||
warn "Entry name=$name\n"
|
||
if $debug > 1;
|
||
|
||
my $result_node=$triples{$entry_node}->{"<${mf}result>"}->[0];
|
||
my $result_file=undef;
|
||
if(defined $result_node) {
|
||
$result_file=($result_node =~ /^<(.+)>$/, $1);
|
||
$result_file =~ s,^file:([^/]+),$1,;
|
||
}
|
||
|
||
warn "Entry result_file=".($result_file || "NONE")."\n"
|
||
if $debug > 1;
|
||
|
||
my $action_node=$triples{$entry_node}->{"<${mf}action>"}->[0];
|
||
|
||
warn "Entry action_node $action_node\n"
|
||
if $debug > 1;
|
||
|
||
my(@data_files)=();
|
||
my(@named_data_files)=();
|
||
for my $data_node (@{$triples{$action_node}->{"<${qt}data>"}}) {
|
||
warn "Entry graph data_node $data_node\n"
|
||
if $debug > 1;
|
||
my $data_file=($data_node =~ /^<(.+)>$/, $1);
|
||
$data_file =~ s,^file:([^/]+),$1,;
|
||
push(@data_files, $data_file);
|
||
}
|
||
for my $data_node (@{$triples{$action_node}->{"<${qt}graphData>"}}) {
|
||
warn "Entry named graph data_node $data_node\n"
|
||
if $debug > 1;
|
||
my $data_file=($data_node =~ /^<(.+)>$/, $1);
|
||
$data_file =~ s,^file:([^/]+),$1,;
|
||
push(@named_data_files, $data_file);
|
||
}
|
||
|
||
my $query_type=$triples{$entry_node}->{"<${rdf}type>"}->[0];
|
||
warn "Query type is ".($query_type ? $query_type : "NONE")."\n"
|
||
if $debug > 1;
|
||
|
||
my $query_node;
|
||
my $expect_fail=0;
|
||
my $execute=1;
|
||
|
||
if($query_type && ($query_type eq "<${mf}PositiveSyntaxTest>" ||
|
||
$query_type eq "<${mfx}TestSyntax>" ||
|
||
$query_type eq "<${mf}NegativeSyntaxTest>" ||
|
||
$query_type eq "<${mfx}TestBadSyntax>")) {
|
||
$query_node=$action_node;
|
||
$execute=0; # Syntax checks do not need execution, just parsing
|
||
$expect_fail=1 if
|
||
$query_type eq "<${mf}NegativeSyntaxTest>" ||
|
||
$query_type eq "<${mfx}TestBadSyntax>";
|
||
} else {
|
||
$query_node=$triples{$action_node}->{"<${qt}query>"}->[0];
|
||
}
|
||
|
||
my $test_uri=$entry_node; $test_uri =~ s/^<(.+)>$/$1/;
|
||
my $test_type=$query_type; $test_type =~ s/^<(.+)>$/$1/ if defined $test_type;
|
||
|
||
my $test_approval=$triples{$entry_node}->{"<${dawgt}approval>"}->[0];
|
||
if($test_approval) {
|
||
warn "Test $name ($test_uri) state $test_approval\n"
|
||
if $debug > 1;
|
||
if($test_approval eq "<${dawgt}Withdrawn>") {
|
||
warn "Test $name ($test_uri) was withdrawn\n"
|
||
if $debug;
|
||
goto next_list_node;
|
||
}
|
||
}
|
||
|
||
my $query_file=undef;
|
||
if($query_node) {
|
||
$query_file=($query_node =~ /^<(.+)>$/, $1);
|
||
$query_file =~ s,^file:/*,/,;
|
||
|
||
warn "Entry data_files=",join(", ",@data_files),"\n"
|
||
if $debug > 1;
|
||
warn "Entry named data_files=",join(", ",@named_data_files),"\n"
|
||
if $debug > 1;
|
||
warn "Entry query_file=$query_file\n"
|
||
if $debug > 1;
|
||
}
|
||
|
||
if (!$unique_test || ($unique_test && (($name eq $unique_test) ||
|
||
($test_uri =~ /$unique_test/)))) {
|
||
push(@tests, {name => $name,
|
||
dir => $srcdir,
|
||
test_file => $query_file,
|
||
data_files => \@data_files,
|
||
named_data_files => \@named_data_files,
|
||
result_file => $result_file,
|
||
expect_fail => $expect_fail,
|
||
test_type => $test_type,
|
||
test_uri => $test_uri,
|
||
execute => $execute
|
||
} );
|
||
|
||
last if $unique_test;
|
||
}
|
||
|
||
next_list_node:
|
||
$list_node=$triples{$list_node}->{"<${rdf}rest>"}->[0];
|
||
last if $list_node eq "<${rdf}nil>";
|
||
}
|
||
|
||
|
||
my(@failed);
|
||
my(@passed);
|
||
my $result=0;
|
||
for my $test (@tests) {
|
||
my($config)=$test;
|
||
|
||
my $rc = run_test($config);
|
||
|
||
$rc=!$rc
|
||
if $config->{expect_fail};
|
||
|
||
if($rc) {
|
||
push(@failed, $config);
|
||
} else {
|
||
push(@passed, $config);
|
||
}
|
||
}
|
||
|
||
unlink "roqet.out", "result.out", "diff.out", "roqet.err", "roqet.tmp"
|
||
unless $unique_test;
|
||
|
||
if($earl_report_file) {
|
||
my $is_new=(!-r $earl_report_file);
|
||
my $rasqal_version=`$roqet --version`;
|
||
my(@t)=gmtime;
|
||
my $rasqal_date=sprintf("%04d-%02d-%02d", 1900+$t[5], 1+$t[4], $t[3]);
|
||
chomp $rasqal_version;
|
||
if(open(PIPE, "svn info . |")) {
|
||
while(<PIPE>) {
|
||
if(/^Revision:\s*(\d+)/) {
|
||
$rasqal_version .= " SVN r$1";
|
||
}
|
||
}
|
||
close(PIPE);
|
||
}
|
||
open(OUT, ">>$earl_report_file")
|
||
or die "Cannot write to $earl_report_file - $!\n";
|
||
print OUT <<"EOT"
|
||
\@prefix doap: <http://usefulinc.com/ns/doap\#> .
|
||
\@prefix earl: <http://www.w3.org/ns/earl\#> .
|
||
\@prefix foaf: <http://xmlns.com/foaf/0.1/> .
|
||
\@prefix xsd: <http://www.w3.org/2001/XMLSchema\#> .
|
||
|
||
_:author a foaf:Person;
|
||
foaf:homepage <http://www.dajobe.org/>;
|
||
foaf:name "Dave Beckett".
|
||
|
||
<${rasqal_url}> a doap:Project;
|
||
doap:name "Rasqal";
|
||
doap:release
|
||
[ a doap:Version;
|
||
doap:created "$rasqal_date"^^xsd:date ;
|
||
doap:name "rasqal ${rasqal_version}"].
|
||
EOT
|
||
if $is_new;
|
||
|
||
for my $config (@failed) {
|
||
my $test_uri=$config->{test_uri};
|
||
print OUT <<"EOT";
|
||
[] a earl:Assertion;
|
||
earl:assertedBy _:author;
|
||
earl:result [
|
||
a earl:TestResult;
|
||
earl:outcome earl:fail
|
||
];
|
||
earl:subject <${rasqal_url}>;
|
||
earl:test <$test_uri> .
|
||
EOT
|
||
}
|
||
for my $config (@passed) {
|
||
my $test_uri=$config->{test_uri};
|
||
print OUT <<"EOT";
|
||
[] a earl:Assertion;
|
||
earl:assertedBy _:author;
|
||
earl:result [
|
||
a earl:TestResult;
|
||
earl:outcome earl:pass
|
||
];
|
||
earl:subject <${rasqal_url}>;
|
||
earl:test <$test_uri> .
|
||
EOT
|
||
}
|
||
close(OUT);
|
||
}
|
||
|
||
|
||
my $failed_count=scalar(@failed);
|
||
|
||
warn "$program: $failed_count FAILED tests:\n " .
|
||
join("\n ", map { $_->{name}. ($debug ? " (".$_->{test_uri}.")" : "") } @failed) .
|
||
"\n"
|
||
if $failed_count;
|
||
warn "$program: Summary: ".scalar(@passed)." tests passed ".scalar(@failed)." tests failed\n";
|
||
|
||
|
||
exit $failed_count;
|
||
|
||
__END__
|
||
|
||
=head1 NAME
|
||
|
||
check-sparql - run SPARQL tests
|
||
|
||
=head1 SYNOPSIS
|
||
|
||
check-sparql [options] [test ...]
|
||
|
||
=head1 OPTIONS
|
||
|
||
=over 8
|
||
|
||
=item B<--debug>
|
||
|
||
Enable extra debugging output.
|
||
|
||
=item B<--help>
|
||
|
||
Give command help summary.
|
||
|
||
=item B<--manifest> MANIFEST
|
||
|
||
Set the input test MANIFEST file
|
||
|
||
=item B<--earl> EARL
|
||
|
||
Set the output test EARL summary file.
|
||
|
||
=back
|
||
|
||
=head1 DESCRIPTION
|
||
|
||
Run SPARQL tests from a manifest file.
|
||
|
||
=cut
|