view release on metacpan or  search on metacpan

lib/Test/Attean/W3CManifestTestSuite.pm  view on Meta::CPAN

	} elsif ($is_neg_query or $is_neg_update) {
		my ($query)	= eval { $parser->parse_list_from_bytes($bytes) };
		my $ok	= $@ ? 1 : 0;
		$self->record_result('syntax', $ok, $test->as_string);
		if ($ok) {
			pass("syntax $namevalue: $filename");
		} else {
			if ($self->debug) {
				warn $query->as_string;
			}
			fail("syntax $namevalue; $filename (unexpected successful parse)");
		}
	}
}

sub update_eval_test {
	my $self		= shift;
	my $model		= shift;
	my $test		= shift;
	my $count		= shift // 1;
	
	my ($action)	= $model->objects( $test, iri("${MF}action") )->elements;
	my ($result)	= $model->objects( $test, iri("${MF}result") )->elements;
	my ($req)		= $model->objects( $test, iri("${MF}requires") )->elements;
	my ($approved)	= $model->objects( $test, iri("${DAWGT}approval") )->elements;
	my ($queryd)	= $model->objects( $action, iri("${UT}request") )->elements;
	my @data		= $model->objects( $action, iri("${UT}data") )->elements;
	my @gdata		= $model->objects( $action, iri("${UT}graphData") )->elements;
	
	if ($self->strict_approval) {
		unless ($approved) {
			warn "- skipping test because it isn't approved\n" if ($self->debug);
			return;
		}
		if ($approved->equal(iri("${DAWGT}NotClassified"))) {
			warn "- skipping test because its approval is dawgt:NotClassified\n" if ($self->debug);
			return;
		}
	}
	
	my $uri					= URI->new( $queryd->value );
	my $filename			= $uri->file;
	my (undef,$base,undef)	= File::Spec->splitpath( $filename );
	$base					= "file://${base}";
	warn "Loading SPARQL query from file $filename" if ($self->debug);
	my $sparql				= do { local($/) = undef; open(my $fh, '<', $filename) or do { fail("$!: $filename; " . $test->as_string); return }; binmode($fh, ':utf8'); <$fh> };

	my $q			= $sparql;
	$q				=~ s/\s+/ /g;
	if ($self->debug) {
		warn "### test     : " . $test->value . "\n";
		warn "# sparql     : $q\n";
		foreach my $data (@data) {
			warn "# data       : " . $data->value . "\n" if (blessed($data));
		}
		warn "# graph data : " . $_->value . "\n" for (@gdata);
		warn "# result     : " . $result->value . "\n";
		warn "# requires   : " . $req->value . "\n" if (blessed($req));
	}
	
	# TODO: set up remote endpoint mock

	warn "constructing model...\n" if ($self->debug);
	my $test_model	= $self->test_model();
	foreach my $data (@data) {
		eval {
			if (blessed($data)) {
				$test_model->load_urls_into_graph($self->default_graph, $data);
			}
		};
		if ($@) {
			fail($test->value);
			print "# died: " . $test->value . ": $@\n";
			return;
		}
	}
	foreach my $gdata (@gdata) {
		my ($data)	= ($model->objects( $gdata, iri("${UT}data") )->elements)[0] || ($model->objects( $gdata, iri("${UT}graph") )->elements)[0];
		my ($graph)	= $model->objects( $gdata, iri("${RDFS}label") )->elements;
		my $uri		= $graph->value;
		eval {
			$test_model->load_urls_into_graph(iri($uri), $data);
		};
		if ($@) {
			fail($test->as_string);
			print "# died: " . $test->value . ": $@\n";
			return;
		};
	}
	
	my ($result_status)	= $model->objects( $result, iri("${UT}result") )->elements;
	my @resgdata		= $model->objects( $result, iri("${UT}graphData") )->elements;
	my ($resdata)		= $model->objects( $result, iri("${UT}data") )->elements;
	my $expected_model	= memory_model;
	eval {
		if (blessed($resdata)) {
			$expected_model->load_urls_into_graph($self->default_graph, $resdata);
		}
	};
	if ($@) {
		fail($test->as_string);
		print "# died: " . $test->value . ": $@\n";
		return;
	};
	foreach my $gdata (@resgdata) {
		my ($data)	= ($model->objects( $gdata, iri("${UT}data") )->elements)[0] || ($model->objects( $gdata, iri("${UT}graph") )->elements)[0];
		my ($graph)	= $model->objects( $gdata, iri("${RDFS}label") )->elements;
		my $uri		= $graph->value;
		my $return	= 0;
		if ($data) {
			eval {
				$expected_model->load_urls_into_graph(iri($uri), $data);
			};
			if ($@) {
				fail($test->as_string);
				print "# died: " . $test->value . ": $@\n";
				$return	= 1;
			};
			return if ($return);
		}
	}

lib/Test/Attean/W3CManifestTestSuite.pm  view on Meta::CPAN

				}
			}
			foreach my $n (@cdata) {
				my ($bytes, $format)	= $self->construct_data($model, $n);
				my $p					= Attean->get_parser(media_type => $format)->new();
				my $iter				= $p->parse_iter_from_bytes($bytes);
				$test_model->add_iter($iter->as_quads($self->default_graph));
			}
		} catch {
			fail($test->value);
			$self->record_result('evaluation', 0, $test->value);
			print "# died: " . $test->value . ": $_\n";
			$next_stress++;
		};
		next STRESS if $next_stress;
		print STDERR "ok\n" if ($self->debug);

		my $resuri		= URI->new( $result->value );
		my $resfilename	= $resuri->file;
	
		TODO: {
			local($TODO)	= (blessed($req)) ? "requires " . $req->value : '';
			my $comment;
			eval {
				if ($self->debug) {
					my $q	= $sparql;
					$q		=~ s/([\x{256}-\x{1000}])/'\x{' . sprintf('%x', ord($1)) . '}'/eg;
					warn $q;
				}
				
				my ($actual, $type);
				{
					local($::DEBUG)	= 1;
					print STDERR "getting actual results... " if ($self->debug);
					($actual, $type)		= $self->get_actual_results( $filename, $test_model, $sparql, $base, $model, \@sdata );
					print STDERR "ok\n" if ($self->debug);
				}
			
				print STDERR "getting expected results... " if ($self->debug);
				my $expected	= $self->get_expected_results( $resfilename, $type );
				print STDERR "ok\n" if ($self->debug);
			
			#	warn "comparing results...";
				$self->compare_results( $expected, $actual, $test->value, \$comment );
			};
			
			my $ok	= not($@);
			unless ($ok) {
				warn $@;
				fail($test->value);
				$self->record_result('evaluation', 0, $test->value);
			};
			if ($ok) {
			} else {
				print "# failed: " . $test->value . "\n";
			}
		}
	}
}

sub mock_endpoints {
	my $self			= shift;
	my $mock			= shift;
	my $model	= shift;
	my $sdata			= shift;
	
	foreach my $sd (@$sdata) {
		my ($e)		= $model->objects( $sd, iri("${RQ}endpoint") )->elements;
		my @data	= $model->objects( $sd, iri("${RQ}data") )->elements;
		my @gdata	= $model->objects( $sd, iri("${RQ}graphData") )->elements;

		my $endpoint	= $e->value;
		my $test_model	= $self->test_model();
		foreach my $data (@data) {
			if (blessed($data)) {
				$test_model->load_urls_into_graph($self->default_graph, $data);
			}
		}
		foreach my $g (@gdata) {
			my $start = $test_model->size;
			$test_model->load_urls_into_graph($g, $g);
			my $end	= $test_model->size;
			unless ($start < $end) {
				warn "*** Loading file did not result in any new quads: " . $g;
			}
		}
		$mock->register_test_endpoint($endpoint, [$test_model, $self->default_graph]);
	}
}

sub get_actual_results {
	my $self			= shift;
	my $filename		= shift;
	my $model			= shift;
	my $sparql			= shift;
	my $base			= shift;
	my $manifest_model	= shift;
	my $sdata			= shift;
	
	my $bytes	= encode_utf8($sparql);

	my $s 			= AtteanX::Parser::SPARQL->new(base => $base);
	my $algebra;
	eval {
		($algebra)	= $s->parse_list_from_bytes($bytes);
	};
	if ($@) {
		warn "Failed to parse query $filename: $@";
		die $@;
	}
	
	if ($self->debug) {
		warn "Walking algebra:\n";
		warn $algebra->as_string;
	}
	
	if ($self->debug) {
		my $iter	= $model->get_quads;
		warn "Dataset:\n-------------\n";
		while (my $q = $iter->next) {
			say $q->as_string;
		}
		warn "-------------\n";
	}
	
	my $testns	= 'http://example.com/test-results#';
	my $rmodel	= memory_model();

	my $results;
	if ($self->use_idp_planner) {
		my $default_graphs	= [$self->default_graph];
		my $planner	= Test::Attean::TestIDPQueryPlanner->new();
		$self->mock_endpoints($planner, $manifest_model, $sdata);
		my $plan	= $planner->plan_for_algebra($algebra, $model, $default_graphs);
		if ($self->debug) {
			warn "Walking plan:\n";
			warn $plan->as_string;
		}
		$results	= eval { $plan->evaluate($model) };
		warn $@ if $@;
	} else {
		my $e		= Test::Attean::TestSimpleQueryEvaluator->new( model => $model, default_graph => $self->default_graph );
		$self->mock_endpoints($e, $manifest_model, $sdata);
		$results	= eval { $e->evaluate($algebra, $self->default_graph) };
		warn $@ if $@;
	}
	my $count	= 1;
	
	$results	= $results->materialize;
	my $item	= $results->peek;
	
	my $type	= 'bindings';
	if ($item) {
		if ($item->does('Attean::API::Triple')) {
			$type	= 'graph';
		} elsif ($item->does('Attean::API::Term')) {
			$type	= 'boolean';
		}
	}

	$self->print_results("Actual results", \$results) if ($self->results);
	return ($results, $type);
	
	if ($results->is_bindings) {
		return ($results, 'bindings');
	} elsif ($results->is_boolean) {
		$rmodel->add_statement( triple( iri("${testns}result"), iri("${testns}boolean"), literal(($results->get_boolean ? 'true' : 'false'), undef, "${XSD}boolean") ) );
		return ($rmodel->get_statements, 'boolean');
	} elsif ($results->is_graph) {
		return ($results, 'graph');
	} else {
		warn "unknown result type: " . Dumper($results);
	}
}

sub print_results {
	my $self	= shift;
	my $name	= shift;
	my $results	= shift;
	$$results	= $$results->materialize;
	print "$name:\n";
	my $count	= 1;
	while (my $r = $$results->next) {
		printf("%3d %s\n", $count++, $r->as_string);
	}
	$$results->reset;
}

sub get_expected_results {
	my $self		= shift;
	my $file		= shift;
	my $type		= shift;
	
	if ($type eq 'graph') {
		my $model	= memory_model();
		$model->load_urls_into_graph($self->default_graph, iri("file://$file"));
		my $results	= $model->get_quads->map(sub { shift->as_triple }, 'Attean::API::Triple');
		$self->print_results("Expected results", \$results) if ($self->results);
		return $results;
	} elsif ($file =~ /[.](srj|json)/) {
		my $model	= memory_model();
		open(my $fh, '<', $file) or die $!;
		my $parser	= Attean->get_parser('SPARQLJSON')->new();