1#!/usr/bin/perl -w 2# 3# check-sparql - Run Rasqal against W3C SPARQL testsuites 4# 5# USAGE: check-sparql [options] [TEST] 6# 7# Copyright (C) 2004-2014, David Beckett http://www.dajobe.org/ 8# Copyright (C) 2004-2005, University of Bristol, UK http://www.bristol.ac.uk/ 9# 10# This package is Free Software and part of Redland http://librdf.org/ 11# 12# It is licensed under the following three licenses as alternatives: 13# 1. GNU Lesser General Public License (LGPL) V2.1 or any newer version 14# 2. GNU General Public License (GPL) V2 or any newer version 15# 3. Apache License, V2.0 or any newer version 16# 17# You may not use this file except in compliance with at least one of 18# the above three licenses. 19# 20# See LICENSE.html or LICENSE.txt at the top of this package for the 21# complete terms and further detail along with the license texts for 22# the licenses in COPYING.LIB, COPYING and LICENSE-2.0.txt respectively. 23# 24# 25# Requires: 26# roqet (from rasqal) compiled in the parent directory 27# 28# Depends on a variety of rasqal internal debug print formats 29# 30 31 32use strict; 33use File::Basename; 34use Getopt::Long; 35use Pod::Usage; 36use Cwd; 37 38use POSIX qw(WIFSIGNALED WIFEXITED WTERMSIG WEXITSTATUS); 39# We really want WCOREDUMP too 40sub WCOREDUMP($) { 41 return $_[0] & 0200; 42} 43 44my $CURDIR = getcwd; 45 46 47sub get_utils_dir() { 48 my $dir = $CURDIR; 49 while($dir ne '' && ! -d "$dir/utils") { 50 $dir =~ s{/[^/]+$}{}; 51 } 52 if($dir eq '') { 53 die "$0: Could not find 'utils' dir in parent directories\n"; 54 } 55 $dir . "/utils"; 56} 57 58our $UTILS_DIR = get_utils_dir(); 59our $TO_NTRIPLES = $ENV{TO_NTRIPLES} || $UTILS_DIR. '/to-ntriples'; 60our $ROQET = $ENV{ROQET} || $UTILS_DIR . '/roqet'; 61 62my $rasqal_url="http://librdf.org/rasqal/"; 63my $diff_cmd=$ENV{DIFF} || "diff"; 64 65my $rdf='http://www.w3.org/1999/02/22-rdf-syntax-ns#'; 66my $rs='http://www.w3.org/2001/sw/DataAccess/tests/result-set#'; 67my $resultVariable_predicate="<${rs}resultVariable>"; 68my $variable_predicate="<${rs}variable>"; 69my $value_predicate="<${rs}value>"; 70my $binding_predicate="<${rs}binding>"; 71my $solution_predicate="<${rs}solution>"; 72my $index_predicate="<${rs}index>"; 73 74my(@manifest_files)=qw(manifest.ttl manifest.n3); 75my $mf='http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#'; 76my $mfx='http://jena.hpl.hp.com/2005/05/test-manifest-extra#'; 77my $qt='http://www.w3.org/2001/sw/DataAccess/tests/test-query#'; 78my $dawgt='http://www.w3.org/2001/sw/DataAccess/tests/test-dawg#'; 79my $ut='http://www.w3.org/2009/sparql/tests/test-update#'; 80my $sd='http://www.w3.org/ns/sparql-service-description#'; 81my $ent='http://www.w3.org/ns/entailment/'; 82 83my $program=basename $0; 84my $debug=0; 85my $srcdir='.'; 86 87$debug=1 if defined $ENV{'RASQAL_DEBUG'}; 88 89# Temporary file names 90our $roqet_out = "roqet.out"; 91our $result_out = "result.out"; 92our $roqet_tmp = 'roqet.tmp'; 93our $roqet_err = 'roqet.err'; 94our $diff_out = 'diff.out'; 95our $to_ntriples_err = 'to_ntriples.err'; 96 97 98# plural('result', 's', 2); 99sub plural($$$) { 100 my($word,$multiple,$count)=@_; 101 return ($count == 1) ? $count." ".$word : $count." ".$word.$multiple; 102} 103 104 105sub toDebug($) { 106 my $str=shift; 107 108 return undef if !defined $str; 109 110 return "NULL" if $str eq "<${rs}undefined>"; 111 112 return $str if $str =~ s/^("[^"]*")(@.*)(\^\^<.*>)$/string($1$2$3)/; 113 114 return $str if $str =~ s/^("[^"]*"\^\^<.*>)$/string($1)/; 115 116 return $str if $str =~ s/^("[^"]*"@.*)$/string($1)/; 117 118 return $str if $str =~ s/^("[^"]*")$/string($1)/; 119 120 return $str if $str =~ s/^(<.*>)$/uri$1/; 121 122 #return $str if $str =~ s/^_:(.*)$/blank $1/; 123 return $str if $str =~ s/^_:(.*)$/blank _/; 124 125 return qq{string("$str")}; 126} 127 128 129sub read_query_results_file($$) { 130 my($result_file,$results_input_format)=@_; 131 132 my(%results)=(rows => []); 133 134 my $cmd="$ROQET -q -R $results_input_format -r simple -t '$result_file'"; 135 136 warn "$program: (read_query_results_file): Running $cmd\n" 137 if $debug; 138 open(PIPE, "$cmd 2>'$roqet_err' |"); 139 my(@vars)=(); 140 while(<PIPE>) { 141 chomp; 142 next unless /^row: \[(.*)\]$/; 143 144 my(@row_vars)=(); 145 my(@values)=(); 146 for my $col (split(/, /, $1)) { 147 my($var,$val)=split(/=/, $col, 2); 148 push(@row_vars, $var); 149 push(@values, $val); 150 } 151 152 if(!@vars) { 153 @vars = @row_vars; 154 warn "$program: results variables are @vars\n" 155 if $debug; 156 } 157 158 my($row) = {}; 159 for my $i (0..$#vars) { 160 my($variable) = $vars[$i]; 161 my $value = $values[$i]; 162 163 $value =~ s/blank \w+/blank _/; 164 165 $row->{$variable} = $value; 166 warn "$variable : ".(defined $value ? $value : "(undefined)")."\n" 167 if $debug; 168 } 169 push(@{$results{rows}}, $row); 170 } 171 close(PIPE); 172 173 return \%results; 174} 175 176 177sub read_rdf_graph_file($$) { 178 my($result_file, $base_uri)=@_; 179 180 my $cmd="$TO_NTRIPLES '$result_file' '$base_uri'"; 181 182 warn "$program: (read_rdf_graph_file): Running $cmd\n" 183 if $debug; 184 185 my $result_string=''; 186 open(PIPE, "$cmd 2>'$to_ntriples_err' |"); 187 while(<PIPE>) { 188 $result_string .= $_; 189 } 190 close(PIPE); 191 192 open(ERR, "<", $to_ntriples_err) or die "$program: Cannot open $to_ntriples_err - $!\n"; 193 my(@errs)=(); 194 while(<ERR>) { 195 chomp; 196 push(@errs, "$result_file: $1") if m{to-ntriples: Error - (.*)$}; 197 } 198 close(ERR); 199 if(@errs) { 200 warn "$program: parsing RDF graph result file '$result_file' FAILED - to_ntriples returned errors:\n ".join("\n ",@errs)."\n"; 201 warn "Failing program was:\n"; 202 warn " $cmd\n"; 203 my $r=$cmd; $r =~ s,file:[^ ]+/,,g; $r =~ s,$CURDIR/,,g; 204 warn " OR $r\n"; 205 return undef; 206 } 207 208 unlink $to_ntriples_err; 209 210 my(%results)=(graph_ntriples => $result_string); 211 212 return \%results; 213} 214 215 216sub compare_rdf_graphs($$$) { 217 my($file1, $file2, $out)=@_; 218 my $cmd; 219 my $rc; 220 my $errors; 221 if(defined $ENV{NTC}) { 222 my $ntc = $ENV{NTC}; 223 $cmd="$ntc '$file1' '$file2' >'$out' 2>&1"; 224 $rc = system($cmd); 225 } elsif(defined $ENV{JENAROOT}) { 226 my $j = $ENV{JENAROOT}; 227 my $classpath=join(':',glob("$j/lib/*jar")); 228 $cmd = qq{java -cp $classpath jena.rdfcompare '$file1' '$file2' N-TRIPLE N-TRIPLE >'$out'}; 229 $rc = system($cmd); 230 if($rc) { 231 $cmd = "$diff_cmd -u '$file1' '$file2' >'$out'"; 232 system($cmd); 233 } 234 } else { 235 $cmd = "$diff_cmd -u '$file1' '$file2' >'$out'"; 236 $rc = system($cmd); 237 } 238 239 return $rc; 240} 241 242 243sub defined_or_NULL($) { 244 return defined($_[0]) ? $_[0] : 'NULL'; 245} 246 247 248sub slurp_file($) { 249 my $file=shift; 250 return do { 251 local $/ = undef; 252 open my $fh, "<", $file or die "$program: Could not read $file - $!\n"; 253 <$fh>; 254 } 255} 256 257sub cat_file($) { 258 my $file=shift; 259 my $fh; 260 open $fh, "<", $file or die "$program: Could not read $file - $!\n"; 261 print <$fh>; 262} 263 264 265sub yesno($) { 266 $_[0] ? "yes" : "no"; 267} 268 269 270sub run_test { 271 my($config)=@_; 272 my($name,$dir,$test_file,$result_file,$expect,$language, 273 $warning_level,$cardinality_mode) 274 = 275 ($config->{name}, $config->{dir}, $config->{test_file}, 276 $config->{result_file}, $config->{expect}, $config->{language}, 277 $config->{warning_level}, $config->{cardinality_mode}); 278 my($test_uri)=$config->{test_uri}; 279 my(@data_files)=@{$config->{data_files}}; 280 my(@named_data_files)=@{$config->{named_data_files}}; 281 my $test_type = $config->{test_type}; 282 my $execute = $config->{execute}; 283 284 # Make sure we don't use any more config 285 $config = undef; 286 287 $language ||= 'sparql'; 288 289 my $test_result = { 290 'name' => $name, 291 'uri' => $test_uri, 292 }; 293 294 $name ||= $test_uri; 295 296 warn "run_test(\n name : $name\n dir : $dir\n language : $language\n query : $test_file\n data : ",join("; ",@data_files),"\n named data : ",join("; ",@named_data_files),"\n result : ",($result_file||"none"),"\n expect : $expect\n card mode : $cardinality_mode\n execute : ".yesno($execute).")\n" 297 if $debug; 298 299 my(@args)=(); 300 push(@args, "-i", $language); 301 # http://www.w3.org/2009/sparql/docs/tests/README.html#csvtests 302 if(defined $test_type && $test_type eq "${mf}CSVResultFormatTest") { 303 push(@args, "-r", "csv"); 304 } else { 305 push(@args, "-d", "debug"); 306 } 307 push(@args, "-W", $warning_level); 308 309 for my $df (@data_files) { 310 $df =~ s,^$CURDIR/,,; 311 push(@args, "-D", $df); 312 } 313 for my $ndf (@named_data_files) { 314 $ndf =~ s,^$CURDIR/,,; 315 push(@args, "-G", $ndf); 316 } 317 push(@args, "-n") 318 unless $execute; 319 320 my $tf = $test_file; $tf =~ s,^$CURDIR/,,; 321 322 my $args_s = join(" ",@args); 323 my $roqet_cmd="$ROQET $args_s '$tf' 2>'$roqet_err' >'$roqet_tmp'"; 324 my $sort="sort"; 325 326 warn "$program: Running $roqet_cmd\n" 327 if $debug; 328 my $start_time = time; 329 system($roqet_cmd); 330 my $end_time = time; 331 my $rc = $?; 332 333 my $core_dumped = WCOREDUMP($rc); 334 $test_result->{'elapsed-time'}= $end_time - $start_time; 335 $test_result->{'roqet-status-code'}= WIFEXITED($rc) ? WEXITSTATUS($rc) : undef; 336 $test_result->{'stdout'} = slurp_file($roqet_tmp); 337 $test_result->{'stderr'} = slurp_file($roqet_err); 338 339 $test_result->{'query'}=$roqet_cmd; 340 341 if(WIFSIGNALED($rc)) { 342 # exec()ed but died on a signal 343 my $signal = WTERMSIG($rc); 344 $rc = "died with signal $signal"; 345 } elsif(WIFEXITED($rc)) { 346 $rc = WEXITSTATUS($rc); 347 if($rc) { 348 # exec()ed and exited with non-0 349 $rc = "exited with status $rc"; 350 } 351 } else { 352 $rc = "system() returned unknown status code $rc"; 353 } 354 $rc .=" with coredump" if $core_dumped; 355 356 warn "$program: roqet returned code $rc\n" 357 if $debug; 358 if($rc) { 359 $test_result->{'result'}='failure'; 360 361 if($expect eq "fail" && !$core_dumped) { 362 warn "$program: '$name' ok - got expected failure\n"; 363 } else { 364 warn "$program: '$name' FAILED ($rc)\n"; 365 print STDERR "Failing program was:\n"; 366 print STDERR " $roqet_cmd\n"; 367 print STDERR $test_result->{'stderr'}; 368 } 369 370 return $test_result; 371 } 372 373 if(defined $test_type && $test_type eq "${mf}CSVResultFormatTest") { 374 my $file = $result_file; 375 my $cmd = "$diff_cmd -u '$roqet_tmp' '$file' >'$diff_out'"; 376 $rc = system($cmd); 377 if($rc) { 378 warn "$program: '$name' FAILED\n"; 379 print STDERR "Failing program was:\n"; 380 print STDERR " $roqet_cmd\n"; 381 warn "Difference is:\n"; 382 cat_file($diff_out); 383 $test_result->{'result'}='failure'; 384 return $test_result; 385 } 386 warn "$program: '$name' ok\n"; 387 $test_result->{'result'}='success'; 388 return $test_result; 389 } 390 391 392 unlink $roqet_tmp; 393 394 my $sorted=0; 395 my $first_result=1; 396 my $roqet_results_count=0; 397 my $result_type='bindings'; 398 my(@vars_order); 399 my(%vars_seen); 400 401 for (split(/\n/, $test_result->{'stdout'})) { 402 if(/^projected variable names: (.*)$/) { 403 for my $vname (split(/,\s*/, $1)) { 404 unless($vars_seen{$vname}) { 405 push(@vars_order, $vname); 406 $vars_seen{$vname}=1; 407 } 408 } 409 warn "$program: Set vars order to @vars_order\n" 410 if $debug; 411 } 412 413 if(/^query verb:\s+(\S+)/) { 414 my $verb = $1; 415 $result_type='graph' if $verb eq 'CONSTRUCT'; 416 $result_type='boolean' if $verb eq 'ASK'; 417 } 418 419 s/blank \w+/blank _/g; 420 421 if (m/query order conditions:/) { 422 $sorted=1; 423 $sort=$sorted ? "cat " : "sort "; 424 } 425 426 if (m/^(?:row|result): \[(.*)\]$/) { 427 s/=INV:/=/g; 428 s/=udt/=string/g; 429 s%=xsdstring\((.*?)\)%=string("$1"^^<http://www.w3.org/2001/XMLSchema#string>)%g; 430 my $line=$_; 431 432 if($first_result) { 433 open(OUT, "|$sort >'$roqet_out'") or die "$program: Cannot create pipe to $roqet_out - $!\n"; 434 $first_result=0; 435 } 436 437 print OUT "$line\n"; 438 $roqet_results_count++; 439 } 440 441 # RDF Graph result - seen N-Triple; sort -u to attempt to get canonical graph 442 if(m/^[_<]/) { 443 my $line = $_; 444 if($first_result) { 445 open(OUT, "|$sort -u >'$roqet_out'") or die "$program: Cannot create pipe to $roqet_out - $!\n"; 446 $first_result=0; 447 } 448 449 print OUT "$line\n"; 450 } 451 452 } 453 454 if($first_result) { 455 open(OUT, ">", $roqet_out) or die "$program: Cannot create pipe to $roqet_out - $!\n"; 456 } 457 close(OUT); 458 459 $test_result->{'result-type'} = $result_type; 460 461 462 open(ERR, "<", $roqet_err) or die "$program: Cannot open $roqet_err - $!\n"; 463 my(@errs)=(); 464 while(<ERR>) { 465 chomp; 466 push(@errs, "$test_file:$1: $2") if /(\d+) rasqal error - (.*)$/; 467 } 468 close(ERR); 469 if(@errs) { 470 warn "$program: '$name' FAILED (query returned errors)\n$program: ".join("\n$program: ",@errs)."\n"; 471 472 $test_result->{'errors'} = join("\n", @errs); 473 print STDERR "Failing program was:\n"; 474 print STDERR " $roqet_cmd\n"; 475 print STDERR $test_result->{'stderr'}; 476 $test_result->{'result'}='failure'; 477 478 return $test_result; 479 } 480 481 my $cmd; 482 483 my $results = {expect_empty => 1}; 484 485 my $result_file_base_uri; 486 if(defined $result_file) { 487 $result_file_base_uri = "file://$result_file"; 488 $result_file =~ s,^$CURDIR/,,; 489 } 490 491 492 if($result_type eq 'graph') { 493 warn "$program: Reading RDF graph result file $result_file\n" 494 if $debug; 495 if(defined $result_file) { 496 $results = read_rdf_graph_file($result_file, $result_file_base_uri); 497 } 498 } else { 499 if(defined $result_file) { 500 if($result_file =~ /\.srx$/) { 501 warn "$program: Reading SPARQL XML bindings result file $result_file\n" 502 if $debug; 503 $results = read_query_results_file($result_file, 'xml'); 504 } elsif($result_file =~ /\.srj$/) { 505 warn "$program: '$name' FAILED (Cannot read SPARQL results in JSON)\n"; 506 $test_result->{'result'}='failure'; 507 508 return $test_result; 509 } elsif($result_file =~ /\.(csv|tsv)$/) { 510 my $result_format = $1; 511 warn "$program: Reading CSV/TSV bindings result file $result_file\n" 512 if $debug; 513 $results = read_query_results_file($result_file, $result_format); 514 } else { 515 warn "$program: Reading RDF syntax encoding bindings result file $result_file\n" 516 if $debug; 517 my $result_format = ($result_file =~ /\.rdf/ ? 'rdfxml' : 'turtle'); 518 $results = read_query_results_file($result_file, $result_format); 519 } 520 } 521 } 522 523 if(!defined $results) { 524 $test_result->{'result'}='failure'; 525 526 return $test_result; 527 } 528 529 if(exists $results->{expect_empty}) { 530 warn "$program: '$name' ok (no result)\n"; 531 $test_result->{'result'} = ($expect eq 'fail') ? 'failure' : 'success'; 532 533 return $test_result; 534 } 535 536 my $count; 537 if($result_type eq 'bindings') { 538 open(OUT, "|$sort >'$result_out'") 539 or die "$program: Cannot create pipe to $result_out - $!\n"; 540 541 $count=0; 542 for my $row (@{$results->{rows}}) { 543 my(@vals) = map { $_ . '=' . defined_or_NULL($row->{$_}) } @vars_order; 544 print OUT "row: [", join(", ", @vals), "]\n"; 545 $count++; 546 } 547 close(OUT); 548 549 $test_result->{'expected-results-count'} = $count; 550 $test_result->{'actual-results-count'} = $roqet_results_count; 551 } else { 552 # graph: sort N-Triples in attempt to get canonical graph 553 open(OUT, "| sort -u >'$result_out'") 554 or die "$program: Cannot create pipe to $result_out - $!\n"; 555 print OUT $results->{graph_ntriples} 556 if exists $results->{graph_ntriples}; 557 close(OUT); 558 } 559 560 if($result_type eq 'graph') { 561 $rc = compare_rdf_graphs($result_out, $roqet_out, $diff_out); 562 } else { 563 $cmd = "$diff_cmd -u '$result_out' '$roqet_out' >'$diff_out'"; 564 $rc = system($cmd); 565 } 566 567 if($rc && $result_type eq 'bindings' && $roqet_results_count <= $count && 568 $cardinality_mode eq 'lax') { 569 warn "$program: Cardinality lax - letting $roqet_results_count result match [1, $count] expected results\n" 570 if $debug; 571 $rc = 0; 572 } 573 574 if($rc) { 575 if($result_type eq 'bindings' && $count != $roqet_results_count) { 576 warn "$program: '$name' FAILED (Expected ".plural("result","s",$count).", got $roqet_results_count)\n"; 577 } else { 578 warn "$program: '$name' FAILED\n"; 579 } 580 print STDERR "Failing program was:\n"; 581 print STDERR " $roqet_cmd\n"; 582 warn "Difference is:\n"; 583 cat_file($diff_out); 584 $test_result->{'result'}='failure'; 585 return $test_result; 586 } 587 588 warn "$program: '$name' ok\n"; 589 $test_result->{'result'}='success'; 590 return $test_result; 591} 592 593sub html_escape($) { 594 my($str)=@_; 595 return undef if !defined $str; 596 597 $str =~ s/\&/\&/gs; 598 $str =~ s/</\</gs; 599 $str =~ s/>/\>/gs; 600 601 return $str; 602} 603 604 605 606# Argument handling 607my $usage=0; 608my $manifest_file=undef; 609my $earl_report_file=undef; 610my $junit_report_file=undef; 611my $suite_name=undef; 612my $approved=0; 613my $language='sparql'; 614my $warning_level=0; 615 616GetOptions( 617 'debug|d+' => \$debug, # incremental 618 'srcdir|s=s' => \$srcdir, 619 'input|i=s' => \$language, 620 'manifest|m=s' => \$manifest_file, 621 'earl|e=s' => \$earl_report_file, 622 'junit|j=s' => \$junit_report_file, 623 'suite|u=s' => \$suite_name, 624 'help|h|?' => \$usage, 625 'approved|a' => \$approved, 626 'warnings|W=i' => \$warning_level, # integer 0..100 627) || pod2usage(2); 628 629pod2usage(-verbose => 2) if $usage; 630pod2usage("$0: Too many tests given.\n") if (@ARGV > 1); 631 632my $unique_test=$ARGV[0]; 633$suite_name ||= 'testsuite'; 634 635$srcdir.="/" unless $srcdir =~ m%/$%; 636 637if(!defined $manifest_file) { 638 for my $file (@manifest_files) { 639 next unless -r $srcdir.$file; 640 $manifest_file=$file; 641 } 642} 643die "$program: No manifest file found in $srcdir\n" 644 unless defined $manifest_file; 645 646 647my(%triples); 648my $entries_node; 649my $cmd="$TO_NTRIPLES '$srcdir$manifest_file'"; 650open(MF, "$cmd |") 651 or die "Cannot open pipe from '$cmd' - $!\n"; 652while(<MF>) { 653 chomp; 654 s/\s+\.$//; 655 my($s,$p,$o)=split(/ /,$_,3); 656 die "no p in '$_'\n" unless defined $p; 657 die "no o in '$_'\n" unless defined $o; 658 push(@{$triples{$s}->{$p}}, $o); 659 $entries_node=$o if $p eq "<${mf}entries>"; 660} 661close(MF); 662 663warn "Entries node is '$entries_node'\n" 664 if $debug > 1; 665my $list_node=$entries_node; 666 667my(@tests); 668while($list_node) { 669 warn "List node is '$list_node'\n" 670 if $debug > 1; 671 672 my $entry_node=$triples{$list_node}->{"<${rdf}first>"}->[0]; 673 674 warn "Entry node is '$entry_node'\n" 675 if $debug > 1; 676 677 if(!defined $triples{$entry_node}) { 678 warn "$program: No triples in manifest for test URI $entry_node\n"; 679 goto next_list_node; 680 } 681 682 my $name=$triples{$entry_node}->{"<${mf}name>"}->[0]; 683 $name =~ s/^\"(.*)\"$/$1/ 684 if defined $name; 685 686 warn "Entry name=$name\n" 687 if $debug > 1; 688 689 my $result_node=$triples{$entry_node}->{"<${mf}result>"}->[0]; 690 my $result_file=undef; 691 if(defined $result_node) { 692 $result_file=($result_node =~ /^<(.+)>$/, $1); 693 $result_file =~ s,^file:/+,/,; 694 } 695 696 warn "Entry result_file=".($result_file || "NONE")."\n" 697 if $debug > 1; 698 699 my $action_node=$triples{$entry_node}->{"<${mf}action>"}->[0]; 700 701 warn "Entry action_node $action_node\n" 702 if $debug > 1; 703 704 my(@data_files)=(); 705 my(@named_data_files)=(); 706 for my $data_node (@{$triples{$action_node}->{"<${qt}data>"}}) { 707 warn "Entry graph data_node $data_node\n" 708 if $debug > 1; 709 my $data_file=($data_node =~ /^<(.+)>$/, $1); 710 $data_file =~ s,^file:/+,/,; 711 push(@data_files, $data_file); 712 } 713 for my $data_node (@{$triples{$action_node}->{"<${qt}graphData>"}}) { 714 warn "Entry named graph data_node $data_node\n" 715 if $debug > 1; 716 my $data_file=($data_node =~ /^<(.+)>$/, $1); 717 $data_file =~ s,^file:/+,/,; 718 push(@named_data_files, $data_file); 719 } 720 721 my $query_type=$triples{$entry_node}->{"<${rdf}type>"}->[0]; 722 warn "Query type is ".($query_type ? $query_type : "NONE")."\n" 723 if $debug > 1; 724 725 my $query_node; 726 my $expect='pass'; 727 my $execute=1; 728 729 if(defined $query_type && 730 ($query_type eq "<${ut}UpdateEvaluationTest>" || 731 $query_type eq "<${mf}UpdateEvaluationTest>" || 732 $query_type eq "<${mf}ProtocolTest>" )) { 733 warn "Skipping query type $query_type - not supported\n" 734 if $debug > 1; 735 goto next_list_node; 736 } 737 738 my $lang = 'sparql'; 739 740 if($query_type && ($query_type eq "<${mf}PositiveSyntaxTest>" || 741 $query_type eq "<${mf}PositiveSyntaxTest11>" || 742 $query_type eq "<${mf}PositiveUpdateSyntaxTest11>" || 743 $query_type eq "<${mfx}TestSyntax>" || 744 $query_type eq "<${mf}NegativeSyntaxTest>" || 745 $query_type eq "<${mf}NegativeSyntaxTest11>" || 746 $query_type eq "<${mf}NegativeUpdateSyntaxTest11>" || 747 $query_type eq "<${mfx}TestBadSyntax>")) { 748 749 $lang = 'sparql11' if $query_type =~ /Test11>$/; 750 751 $query_node=$action_node; 752 $execute=0; # Syntax checks do not need execution, just parsing 753 $expect='fail' if 754 $query_type =~ /^<${mf}Negative/ || 755 $query_type eq "<${mf}NegativeSyntaxTest>" || 756 $query_type eq "<${mfx}TestBadSyntax>"; 757 } else { 758 $query_node=$triples{$action_node}->{"<${qt}query>"}->[0]; 759 } 760 761 my $resultCardinality = $triples{$entry_node}->{"<${mf}resultCardinality>"}->[0]; 762 my $cardinality_mode = (defined $resultCardinality && $resultCardinality eq "<${mf}LaxCardinality>") ? 'lax' : 'strict'; 763 warn "Cardinality mode is $cardinality_mode\n" 764 if $debug > 1; 765 766 my $test_uri=$entry_node; $test_uri =~ s/^<(.+)>$/$1/; 767 my $test_type=$query_type; $test_type =~ s/^<(.+)>$/$1/ if defined $test_type; 768 769 my $test_approval=$triples{$entry_node}->{"<${dawgt}approval>"}->[0]; 770 my $is_approved = 0; 771 my $is_withdrawn = 0; 772 if($test_approval) { 773 warn "Test $name ($test_uri) state $test_approval\n" 774 if $debug > 1; 775 if($test_approval eq "<${dawgt}Withdrawn>") { 776 warn "Test $name ($test_uri) was withdrawn\n" 777 if $debug; 778 $is_withdrawn = 1; 779 } 780 if($test_approval eq "<${dawgt}Approved>") { 781 $is_approved = 1; 782 } 783 } 784 785 my $has_entailment_regime = exists $triples{$action_node}->{"<${ent}entailmentRegime>"} || $triples{$action_node}->{"<${sd}entailmentRegime>"};; 786 787 my $query_file=undef; 788 if($query_node) { 789 $query_file=($query_node =~ /^<(.+)>$/, $1); 790 $query_file =~ s,^file:/*,/,; 791 792 warn "Entry data_files=",join(", ",@data_files),"\n" 793 if $debug > 1; 794 warn "Entry named data_files=",join(", ",@named_data_files),"\n" 795 if $debug > 1; 796 warn "Entry query_file=$query_file\n" 797 if $debug > 1; 798 } 799 800 if (!$unique_test || ($unique_test && (($name eq $unique_test) || 801 ($test_uri =~ /$unique_test/)))) { 802 push(@tests, {name => $name, 803 dir => $srcdir, 804 test_file => $query_file, 805 data_files => \@data_files, 806 named_data_files => \@named_data_files, 807 result_file => $result_file, 808 expect => $expect, 809 test_type => $test_type, 810 test_uri => $test_uri, 811 execute => $execute, 812 language => $lang, 813 cardinality_mode => $cardinality_mode, 814 is_withdrawn => $is_withdrawn, 815 is_approved => $is_approved, 816 has_entailment_regime => $has_entailment_regime 817 } ); 818 819 last if $unique_test; 820 } 821 822next_list_node: 823 $list_node=$triples{$list_node}->{"<${rdf}rest>"}->[0]; 824 last if $list_node eq "<${rdf}nil>"; 825} 826 827die "$program: Test $unique_test not found\n" if $unique_test && !@tests; 828 829my(@failed); 830my(@passed); 831my(@skipped); 832my(@test_results); 833my $result=0; 834my $start_time = time; 835for my $test (@tests) { 836 my($config)=$test; 837 838 $config->{language} = $language; 839 $config->{warning_level} = $warning_level; 840 841 my $test_uri = $config->{test_uri}; 842 my $name = $config->{name} || $test_uri; 843 844 if($config->{is_withdrawn}) { 845 warn "$program: Test $name ($test_uri) was withdrawn - skipping\n" 846 if $debug; 847 push(@skipped, $test); 848 next; 849 } 850 if($approved && !$config->{is_approved}) { 851 warn "$program: Test $name ($test_uri) not approved - skipping\n" 852 if $debug; 853 push(@skipped, $test); 854 next; 855 } 856 if($config->{has_entailment_regime}) { 857 warn "$program: Test $name ($test_uri) has entailment - skipping\n" 858 if $debug > 1; 859 push(@skipped, $test); 860 next; 861 } 862 863 my $test_result = run_test($config); 864 865 my $is_success = ($test_result->{'result'} eq 'success'); 866 $is_success = !$is_success if $config->{expect} eq 'fail'; 867 868 $test_result->{'is-success'} = $is_success; 869 push(@test_results, $test_result); 870 871 if($is_success) { 872 push(@passed, $config); 873 } else { 874 push(@failed, $config); 875 } 876} 877my $end_time = time; 878my $elapsed_time = ($end_time - $start_time); 879 880unlink $roqet_out, $result_out, $roqet_tmp, $roqet_err, $diff_out, $to_ntriples_err 881 unless $unique_test; 882 883my $rasqal_version=`$ROQET -v`; 884chomp $rasqal_version; 885 886if($earl_report_file) { 887 my $is_new=(!-r $earl_report_file); 888 my(@t)=gmtime; 889 my $rasqal_date=sprintf("%04d-%02d-%02d", 1900+$t[5], 1+$t[4], $t[3]); 890 891 my $rasqal_name="Rasqal $rasqal_version"; 892 893 open(OUT, ">>", $earl_report_file) 894 or die "Cannot write to $earl_report_file - $!\n"; 895 print OUT <<"EOT" 896\@prefix doap: <http://usefulinc.com/ns/doap\#> . 897\@prefix earl: <http://www.w3.org/ns/earl\#> . 898\@prefix foaf: <http://xmlns.com/foaf/0.1/> . 899\@prefix xsd: <http://www.w3.org/2001/XMLSchema\#> . 900 901 _:author a foaf:Person; 902 foaf:homepage <http://www.dajobe.org/>; 903 foaf:name "Dave Beckett". 904 905 <${rasqal_url}> a doap:Project; 906 doap:name "Rasqal"; 907 doap:homepage <${rasqal_url}>; 908 doap:release 909 [ a doap:Version; 910 doap:created "$rasqal_date"^^xsd:date ; 911 doap:name "${rasqal_name}"]. 912EOT 913 if $is_new; 914 915 for my $config (@failed) { 916 my $test_uri=$config->{test_uri}; 917 print OUT <<"EOT"; 918 [] a earl:Assertion; 919 earl:assertedBy _:author; 920 earl:result [ 921 a earl:TestResult; 922 earl:outcome earl:fail 923 ]; 924 earl:subject <${rasqal_url}>; 925 earl:test <$test_uri> . 926EOT 927 } 928 for my $config (@passed) { 929 my $test_uri=$config->{test_uri}; 930 print OUT <<"EOT"; 931 [] a earl:Assertion; 932 earl:assertedBy _:author; 933 earl:result [ 934 a earl:TestResult; 935 earl:outcome earl:pass 936 ]; 937 earl:subject <${rasqal_url}>; 938 earl:test <$test_uri> . 939EOT 940 } 941 close(OUT); 942} 943 944 945if($junit_report_file) { 946 my(@t)=gmtime; 947 my $timestamp=sprintf("%04d-%02d-%02dT%02d:%02d:%02d", 948 1900+$t[5], 1+$t[4], $t[3], $t[2], $t[1], $t[0]); 949 950 my $rasqal_name="Rasqal $rasqal_version"; 951 my $hostname="localhost"; 952 953 my $name = $suite_name; 954 my $tests_count = scalar(@passed) + scalar(@failed); 955 my $failures_count = scalar(@failed); 956 my $errors_count = 0; 957 my $runtime = $elapsed_time; 958 my $id = 0; # this <testsuites> has only 1 testsuite 959 960 open(OUT, ">", $junit_report_file) 961 or die "Cannot write to $junit_report_file - $!\n"; 962 print OUT <<"EOT"; 963<?xml version="1.0" encoding="UTF-8" ?> 964<testsuites> 965 <testsuite 966 name="$name" 967 timestamp="$timestamp" 968 hostname="$hostname" 969 tests="$tests_count" 970 failures="$failures_count" 971 errors="$errors_count" 972 time="$runtime" 973 id="$id" 974 > 975 976 <properties> 977 <property name="author-name" value="Dave Beckett" /> 978 <property name="author-homepage" value="http://www.dajobe.org/" /> 979 980 <property name="project-name" value="Rasqal" /> 981 <property name="project-uri" value="${rasqal_url}" /> 982 <property name="project-version" value="${rasqal_name}" /> 983 </properties> 984EOT 985 986 my $system_out = ''; 987 my $system_err = ''; 988 for my $test_result (@test_results) { 989 my $test_uri = $test_result->{uri}; 990 my $test_name = $test_result->{name} || "unknown"; 991 my $class_name = $test_uri; 992 my $is_success = $test_result->{'is-success'}; 993 my $elapsed = $test_result->{'elapsed-time'}; 994 my $test_stdout = $test_result->{'stdout'} || ''; 995 my $test_stderr = $test_result->{'stderr'} || ''; 996 print OUT <<"EOT"; 997 <testcase name="$test_name" classname="$class_name" time="$elapsed_time"> 998EOT 999 1000 if(!$is_success) { 1001 my $message = html_escape("Failed"); 1002 my $type = "org.librdf.fake"; 1003 my $text = html_escape($test_stdout . $test_stderr); 1004 print OUT <<"EOT"; 1005 <failure message="$message" type="$type"> 1006 $text 1007 </failure> 1008 1009EOT 1010 } 1011 1012 # $system_out .= $test_stdout; 1013 # $system_err .= $test_stderr; 1014 print OUT <<"EOT"; 1015 </testcase> 1016 1017EOT 1018 } # test_result loop 1019 1020 $system_out = html_escape($system_out); 1021 $system_err = html_escape($system_err); 1022 print OUT <<"EOT"; 1023 <system-out>$system_out</system-out> 1024 1025 <system-err>$system_err</system-err> 1026 1027 </testsuite> 1028</testsuites> 1029EOT 1030 close(OUT); 1031} 1032 1033 1034my $failed_count=scalar(@failed); 1035 1036if($debug) { 1037warn "$program: $failed_count FAILED tests:\n$program: " . 1038 join("\n$program: ", map { ($_->{name} || $_->{test_uri}). ($debug ? " (".$_->{test_uri}.")" : "") } @failed) . 1039 "\n" 1040 if $failed_count; 1041} 1042warn "$program: Summary: ".scalar(@passed)." tests passed ".scalar(@failed)." tests failed ".scalar(@skipped)." tests skipped\n"; 1043 1044exit $failed_count; 1045 1046__END__ 1047 1048=head1 NAME 1049 1050check-sparql - run SPARQL tests 1051 1052=head1 SYNOPSIS 1053 1054check-sparql [options] [test ...] 1055 1056=head1 OPTIONS 1057 1058=over 8 1059 1060=item B<--debug> 1061 1062Enable extra debugging output. 1063 1064=item B<--help> 1065 1066Give command help summary. 1067 1068=item B<--manifest> MANIFEST 1069 1070Set the input test MANIFEST file 1071 1072=item B<--earl> EARL 1073 1074Set the output test EARL summary file. 1075 1076=item B<--junit> JUNIT 1077 1078Set the output Ant Junit XML results file. 1079 1080=item B<--suite> SUITE 1081 1082Set the test suite name 1083 1084=back 1085 1086=head1 DESCRIPTION 1087 1088Run SPARQL tests from a manifest file. 1089 1090=cut 1091