Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

executable file 555 lines (449 sloc) 17.808 kB
#!/usr/bin/perl -w
#
# manifest.pl - Run Raptor against RDF Core tests Manifest.rdf
#
# Copyright (C) 2002-2006 David Beckett http://www.dajobe.org/
# Copyright (C) 2002-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.
#
#
# USAGE: ./manifest.pl
# to run all known tests from $manifest_URL
#
# ./manifest.pl TEST-URL ...
# to run particular tests (slightly more verbose).
#
use strict;
use File::Basename;
use IO::File;
use LWP::Simple;
my $progname = basename $0;
my $offline=0;
my $global_verbose=1;
my $manifest_URL='http://www.w3.org/2000/10/rdf-tests/rdfcore/Manifest.rdf';
my $local_tests_url='http://www.w3.org/2000/10/rdf-tests/rdfcore/';
# Configuration for OWL-style test run summary RDF generation
# RDF/XML written here
my $results_rdf_file="results.rdf";
# Header info
my $system_name="Raptor RDF Parser";
my $system_desc=<<"EOT";
Raptor RDF Parser Toolkit V1.1.0+ (CVS) as of 2003-10-31
passes all RDF Test Cases Positive and Negative Parser test cases.
EOT
# System URL for r:system
my $system_url="http://librdf.org/raptor/";
# Results URL for r:output
my $results_url="http://librdf.org/raptor/testcases/results.rdf";
# Test run output URL for r:output
my $output_url="http://librdf.org/raptor/testcases/output.txt";
# CHANGE THIS for your system
my $local_tests_area="./rdfcore/";
my $local_manifest_file="./rdfcore/Manifest.rdf";
# Internal globals
my $test_counter=0;
my $format="%-6s %5d %7.2f%%\n";
sub get_test_content($$) {
my($url,$out_file)=@_;
if ($url =~ m%^$local_tests_url(.*)$%) {
my $in_file=$local_tests_area.$1;
return $in_file if -r $in_file;
open(IN, "<$in_file") or die "Cannot read $in_file ($url) - $!\n";
open(OUT, ">$out_file") or die "Cannot write to $out_file - $!\n";
print OUT join('', <IN>);
close(IN);
close(OUT);
} else {
return if $offline;
mirror($url, $out_file);
}
return $out_file;
}
sub emit_testrun_start($) {
my $fh=shift;
print $fh <<"EOT";
<rdf:RDF
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
xmlns:r="http://www.w3.org/2002/03owlt/resultsOntology#"
xmlns:foaf="http://xmlns.com/foaf/0.1/"
xmlns:dc="http://purl.org/dc/elements/1.1/"
xmlns:rdfs="http://www.w3.org/2000/01/rdf-schema#">
<rdf:Description rdf:nodeID="system">
<foaf:homepage rdf:resource="$system_url" />
<rdfs:label>$system_name</rdfs:label>
<rdfs:comment>$system_desc</rdfs:comment>
</rdf:Description>
<!-- RDF schema -->
<rdfs:Class rdf:about="http://www.w3.org/2002/03owlt/resultsOntology#PassingRun"/>
<rdfs:Class rdf:about="http://www.w3.org/2002/03owlt/resultsOntology#IncompleteRun"/>
<rdfs:Class rdf:about="http://www.w3.org/2002/03owlt/resultsOntology#FailingRun"/>
<rdfs:Class rdf:about="http://www.w3.org/2002/03owlt/resultsOntology#TestRun"/>
<rdf:Property rdf:about="http://www.w3.org/2002/03owlt/resultsOntology#test"/>
<rdf:Property rdf:about="http://www.w3.org/2002/03owlt/resultsOntology#output"/>
<rdf:Property rdf:about="http://www.w3.org/2002/03owlt/resultsOntology#system"/>
<rdf:Property rdf:about="http://www.w3.org/2002/03owlt/resultsOntology#begins"/>
<rdf:Property rdf:about="http://www.w3.org/2002/03owlt/resultsOntology#duration"/>
EOT
}
sub emit_testrun_end($) {
my $fh=shift;
print $fh <<"EOT";
</rdf:RDF>
EOT
}
sub emit_testrun_test($$$$$$$) {
my($fh, $test_id, $test_url, $start_time, $end_time, $type, $is_positive)=@_;
# starttime/end_time format: YYYY-MM-DD'T'HH:MM:SS'Z'
my @tm = (gmtime($start_time))[0..5]; $tm[5]+= 1900; $tm[4]++;
$start_time=sprintf("%04d-%02d-%02dT%02d:%02d:%02dZ", reverse @tm);
@tm = (gmtime($end_time))[0..5]; $tm[5]+= 1900; $tm[4]++;
$end_time=sprintf("%04d-%02d-%02dT%02d:%02d:%02dZ", reverse @tm);
if(!$is_positive) {
if($type eq 'BAD') {
$type='OK';
} elsif ($type eq 'OK') {
$type='BAD';
}
}
my(%internal_to_testrun_types)=(
SYSTEM => 'Incomplete',
BAD => 'Failing',
OK => 'Passing'
);
$type=$internal_to_testrun_types{$type} || 'Incomplete';
$type.="Run";
# rdf:nodeID="A$test_id"
print $fh <<"EOT";
<r:$type>
<r:test rdf:resource="$test_url"/>
<r:begins rdf:datatype="http://www.w3.org/2001/XMLSchema#dateTime">$start_time</r:begins>
<r:ends rdf:datatype="http://www.w3.org/2001/XMLSchema#dateTime">$end_time</r:ends>
<r:system rdf:nodeID="system"/>
<r:output rdf:resource="$output_url"/>
<rdf:type rdf:resource="http://www.w3.org/2002/03owlt/resultsOntology#TestRun"/>
</r:$type>
EOT
}
sub run_test($$$$$$) {
my($test_url, $test_status,
$is_positive, $is_verbose, $rdfxml_url, $ntriples_url)=@_;
my $rdfxml_file=get_test_content($rdfxml_url, 'test.rdf');
my $ntriples_file=$is_positive ? get_test_content($ntriples_url, 'test.nt') : undef;
if(!-r $rdfxml_file || ($is_positive && ! -r $ntriples_file)) {
return ();
}
my $plabel=($is_positive) ? 'Positive' : 'Negative';
if($is_verbose) {
print "$progname: $plabel Test $test_url ($test_status)\n";
print " Input RDF/XML $rdfxml_url - $rdfxml_file \n";
print " Output N-Triples $ntriples_url - $ntriples_file\n"
if $ntriples_url;
}
my $cmd="./rapper -q --m strict -o ntriples $rdfxml_file '$rdfxml_url'";
unlink 'test.err', 'parser.nt', 'expected.nt', 'test.ntc';
my $start_time=time;
my $status=system("$cmd 2>test.err >parser.nt");
$status = ($status & 0xff00) >> 8;
my $end_time=time;
if($status > 128) {
return (result=>'SYSTEM', msg=>"$cmd failed - returned status $status\n",
start_time=>$start_time, end_time=>$end_time);
}
# Nothing to compare to, it must be a negative test
if(!$ntriples_url) { # && !$is_positive
if($status) {
return (result=>'BAD', msg=>"$cmd failed\n",
start_time=>$start_time, end_time=>$end_time);
}
return (result=>'OK', msg=>"$cmd succeeded",
start_time=>$start_time, end_time=>$end_time);
}
open(NT,"<$ntriples_file") or die "Cannot read $ntriples_file - $!\n";
open(NT2,">expected.nt") or die "Cannot create expected.nt - $!\n";
while(<NT>) {
next if /^\s*\#/;
next if /^\s*$/;
print NT2;
}
close(NT);
close(NT2);
$cmd="./ntc parser.nt expected.nt > test.ntc";
$status=system("$cmd 2>&1 >/dev/null");
$status = ($status & 0xff00) >> 8;
if($status > 2) {
return (result=>'SYSTEM', msg=>"$cmd failed - returned status $status\n",
start_time=>$start_time, end_time=>$end_time);
}
if($status == 1) {
my $msg=`diff -u expected.nt parser.nt | tail +3`;
return (result=>'BAD', msg=>"N-Triples match failed\n$msg",
start_time=>$start_time, end_time=>$end_time);
}
if($status == 2) {
return (result=>'PRINTINGS', msg=>"N-Triples matched with warnings\n",
start_time=>$start_time, end_time=>$end_time);
}
return (result=>'OK', msg=>"N-Triples matched",
start_time=>$start_time, end_time=>$end_time);
}
sub read_err($) {
my($err)=@_;
open(ERR,"<$err") or die "Cannot read $err - $!\n";
$err=join('', grep(!/(?:raptor_|^\s*attributes|^\s*$)/, <ERR>));
close(ERR);
return $err;
}
sub run_tests($$$$$$@) {
my($fh,$tests,$test_statuses,$is_verbose,$results,$totals,@test_urls)=@_;
for my $test (@test_urls) {
if(!$tests->{$test}) {
print "$progname: No such test $test, skipping\n";
next;
}
my $is_positive=$tests->{$test}->{positive};
my $plabel=($is_positive) ? 'Positive' : 'Negative';
my $inputs=$tests->{$test}->{'test:inputDocument'};
my $outputs=$tests->{$test}->{'test:outputDocument'};
if(!defined $inputs || !$inputs->{'test:RDF-XML-Document'}
||scalar(@{$inputs->{'test:RDF-XML-Document'}}) !=1) {
die "$plabel Test $test has not got exactly 1 input RDF/XML file\n";
}
if($is_positive) {
if(!defined $outputs || !$outputs->{'test:NT-Document'}
||scalar(@{$outputs->{'test:NT-Document'}}) !=1) {
die "$plabel Test $test has not got exactly 1 output N-Triple file\n";
}
}
my $input_rdfxml=$inputs->{'test:RDF-XML-Document'}->[0];
my $output_ntriples=$is_positive ? $outputs->{'test:NT-Document'}->[0] : undef;
my(%this_test_result)=run_test($test, $test_statuses->{$test},
$is_positive, $is_verbose,
$input_rdfxml, $output_ntriples);
my $result=$this_test_result{result};
my $msg=$this_test_result{msg};
emit_testrun_test($fh, $test_counter++, $test,
$this_test_result{start_time},
$this_test_result{end_time},
$result, $is_positive)
if $fh;
if($result eq 'SYSTEM') {
my $err=read_err('test.err');
$msg .= "\n".$err;
print "Test $test SYSTEM ERROR: $msg\n";
push(@{$totals->{SYSTEM}}, $test);
} elsif($result eq 'OK') {
if($is_positive) {
push(@{$totals->{OK}}, $test);
} else {
open(TOUT,"<parser.nt") or die "Cannot read parser.nt - $!\n";
my $out=join("\n ", <TOUT>);
close(TOUT);
$msg= " ".$out;
print "$plabel Test $test SUCCEEDED, should have failed - returned: \n$msg\n";
push(@{$totals->{BAD}}, $test);
}
} else {
if($is_positive) {
my $err=read_err('test.err');
$msg .= "\n".$err;
print "$plabel Test $test FAILED - $msg\n";
push(@{$totals->{BAD}}, $test);
} else {
push(@{$totals->{OK}}, $test);
}
}
$results->{$test}=$result;
}
}
sub summarize_results($$$$;$) {
my($title, $results, $totals, $total, $verbose)=@_;
print "Results for $title\n";
for my $type (sort keys %$totals) {
my(@rt)=@{$totals->{$type}};
my(@short_rt)=map {s/^$local_tests_url//; $_} @rt;
print sprintf($format,$type, scalar(@rt), (int(scalar(@rt)/$total*10000))/100);
if($verbose) {
print " ",join("\n ",@rt),"\n";
}
}
print sprintf($format, 'TOTAL', $total, '100');
}
my(%tests);
my(%test_statuses);
my(@positive_test_urls);
my(@negative_test_urls);
my(@approved_positive_test_urls);
my(@approved_negative_test_urls);
my(@unapproved_positive_test_urls);
my(@unapproved_negative_test_urls);
my(@withdrawn_test_urls);
if($offline) {
print "$progname: OFFLINE - using stored manifest URL $manifest_URL\n";
} else {
print "$progname: Checking mirrored manifest URL $manifest_URL\n";
if(mirror($manifest_URL, $local_manifest_file ) == RC_NOT_MODIFIED) {
print "$progname: OK, not modified\n";
} else {
print "$progname: Unknown error\n";
}
}
# Content from the file
my $content='';
open(IN, "<$local_manifest_file") or die "Cannot read $local_manifest_file - $!\n";
$content .= join('',<IN>);
close($content);
# Remove comments
1 while $content =~ s/<!--.+?-->//gms;
# Unify blanks
$content =~ s/\s+/ /gs;
$content =~ s/\s*$//s;
# Remove everything but tests
$content =~ s%^<\?xml version="1.0"\?> <rdf:RDF[^>]+>%%;
$content =~ s%</rdf:RDF>$%%s;
# Find the tests
while(length $content) {
$content =~ s/^\s+//;
last if !length $content;
if($content =~ s%^<test:(Positive|Negative)ParserTest rdf:about="([^"]+)">(.+?)</test:(Positive|Negative)ParserTest>%%) { # "
my($type,$url,$test_content)=($1,$2,$3);
while(length $test_content) {
$test_content =~ s/^\s+//;
last if !length $test_content;
if($test_content =~ s%^<(\S+) rdf:resource="([^"]+)"\s*/>%%) { #"
$tests{$url}->{$1}=$2;
} elsif ($test_content =~ s%^<(test:\w+)>\s*<(test:[-\w]+) rdf:about="([^"]+)"\s*/>\s*</(test:\w+)>%%) { #"
push(@{$tests{$url}->{$1}->{$2}}, $3);
} elsif ($test_content =~ s%^<(test:\w+)>([^<]+)</test:\w+>%%) {
$tests{$url}->{$1}=$2;
} elsif ($test_content =~ s%^<test:\w+>\s*<test:[-\w]+\s*/>\s*</test:\w+>\s*%%) {
} else {
die "I'm stumped 1 at test content >>$test_content<<\n";
}
}
my $test_status=$tests{$url}->{'test:status'} || '';
$test_statuses{$url}=$test_status;
if ($test_status =~ /^OBSOLETE/) {
#print "$progname: Ignoring Obsolete Test URL $url\n";
next;
}
if ($type eq 'Positive') {
push(@positive_test_urls, $url);
$tests{$url}->{positive}=1;
} else {
push(@negative_test_urls, $url);
}
if ($test_status eq 'APPROVED') {
if ($type eq 'Positive') {
push(@approved_positive_test_urls, $url);
} else {
push(@approved_negative_test_urls, $url);
}
} elsif ($test_status eq 'NOT_APPROVED' || $test_status eq 'PENDING') {
if ($type eq 'Positive') {
push(@unapproved_positive_test_urls, $url);
} else {
push(@unapproved_negative_test_urls, $url);
}
} elsif ($test_status eq 'WITHDRAWN') {
push(@withdrawn_test_urls, $url);
} else {
print "$progname: Ignoring test with unknown test:status $test_status\n";
next;
}
} elsif($content =~ s%^<test:(Positive|Negative)EntailmentTest rdf:about="([^"]+)">(.+?)</test:(Positive|Negative)EntailmentTest>%%) { # "
my($type,$url,$test_content)=($1,$2,$3);
while(length $test_content) {
$test_content =~ s/^\s+//;
last if !length $test_content;
if($test_content =~ s%^<(\S+) rdf:resource="([^"]+)"\s*/>%%) { #"
$tests{$url}->{$1}=$2;
} elsif ($test_content =~ s%^<(test:\w+)>\s*<(test:[-\w]+) rdf:about="([^"]+)"\s*/>\s*</(test:\w+)>%%) { #"
push(@{$tests{$url}->{$1}->{$2}}, $3);
} elsif ($test_content =~ s%^<(test:\w+)>([^<]+)</test:\w+>%%) {
$tests{$url}->{$1}=$2;
} elsif ($test_content =~ s%^<test:\w+>\s*<test:[-\w]+\s*/>\s*</test:\w+>\s*%%) {
} else {
die "I'm stumped 2 at test content >>$test_content<<\n";
}
}
my $test_status=$tests{$url}->{'test:status'} || 'not APPROVED';
#print "$progname: Ignoring $type Entailment Test URL $url ($test_status)\n";
} elsif($content =~ s%^<test:MiscellaneousTest rdf:about="([^"]+)">(.+?)</test:MiscellaneousTest>%%) { # "
my($url,$test_content)=($1,$2);
while(length $test_content) {
$test_content =~ s/^\s+//;
last if !length $test_content;
if($test_content =~ s%^<(\S+) rdf:resource="([^"]+)"\s*/>%%) { #"
$tests{$url}->{$1}=$2;
} elsif ($test_content =~ s%^<(test:\w+)>\s*<(test:[-\w]+) rdf:about="([^"]+)"\s*/>\s*</(test:\w+)>%%) { #"
push(@{$tests{$url}->{$1}->{$2}}, $3);
} elsif ($test_content =~ s%^<(test:\w+)>([^<]+)</test:\w+>%%) {
$tests{$url}->{$1}=$2;
} elsif ($test_content =~ s%^<test:\w+>\s*<test:[-\w]+\s*/>\s*</test:\w+>\s*%%) {
} else {
die "I'm stumped 3 at test content >>$test_content<<\n";
}
}
my $test_status=$tests{$url}->{'test:status'} || 'not APPROVED';
#print "$progname: Ignoring Miscellaneous Test URL $url ($test_status)\n";
} else {
die "I'm stumped 4 at content >>$content<<\n";
}
}
print "$progname: Parser tests found:\n";
print "$progname: Positive: ",scalar(@positive_test_urls),"\n";
print "$progname: Negative: ",scalar(@negative_test_urls),"\n";
print "$progname: APPROVED parser tests found:\n";
print "$progname: Positive: ",scalar(@approved_positive_test_urls),"\n";
print "$progname: Negative: ",scalar(@approved_negative_test_urls),"\n";
print "$progname: not APPROVED parser tests found:\n";
print "$progname: Positive: ",scalar(@unapproved_positive_test_urls),"\n";
print "$progname: Negative: ",scalar(@unapproved_negative_test_urls),"\n";
print "$progname: withdrawn parser tests found: ",scalar(@withdrawn_test_urls),"\n";
print "\n\n";
my(%results);
if(@ARGV) {
my(%totals);
print "$progname: Running user parser tests:\n";
run_tests(undef, \%tests, \%test_statuses, 1, \%results, \%totals, @ARGV);
summarize_results("User Parser Tests", \%results, \%totals, scalar(@ARGV));
exit 0;
}
my $fh=new IO::File ">$results_rdf_file";
if($fh) {
emit_testrun_start($fh)
}
my(%approved_positive_totals)=();
run_tests($fh, \%tests, \%test_statuses, $global_verbose, \%results, \%approved_positive_totals, @approved_positive_test_urls);
summarize_results("Positive Approved Parser Tests", \%results, \%approved_positive_totals, scalar(@approved_positive_test_urls));
print "\n\n";
my(%approved_negative_totals)=();
run_tests($fh, \%tests, \%test_statuses, $global_verbose, \%results, \%approved_negative_totals, @approved_negative_test_urls);
summarize_results("Negative Approved Parser Tests", \%results, \%approved_negative_totals, scalar(@approved_negative_test_urls));
print "\n\n";
if($fh) {
emit_testrun_end($fh);
close($fh);
warn "Wrote test run RDF/XML to $results_rdf_file - should be installed at $results_url\n";
}
exit 0;
my(%unapproved_positive_totals)=();
run_tests(\%tests, \%test_statuses, $global_verbose, \%results, \%unapproved_positive_totals, @unapproved_positive_test_urls);
summarize_results("Not APPROVED Positive Parser Tests", \%results, \%unapproved_positive_totals, scalar(@unapproved_positive_test_urls),1);
print "\n\n";
my(%unapproved_negative_totals)=();
run_tests(\%tests, \%test_statuses, $global_verbose, \%results, \%unapproved_negative_totals, @unapproved_negative_test_urls);
summarize_results("Not APPROVED Negative Parser Tests", \%results, \%unapproved_negative_totals, scalar(@unapproved_negative_test_urls),1);
Jump to Line
Something went wrong with that request. Please try again.