This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/packages/sgml/RDF/w3c_test.pl

468 lines
11 KiB
Perl
Raw Normal View History

/* $Id$
Part of SWI-Prolog SGML/XML parser
Author: Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
WWW: http://www.swi.psy.uva.nl/projects/SWI-Prolog/
Copying: LGPL-2. See the file COPYING or http://www.gnu.org
Copyright (C) 1990-2002 SWI, University of Amsterdam. All rights reserved.
*/
:- module(rdf_w3c_test,
[ process_manifest/0,
process_manifest/1,
run_tests/0, % run all tests
run/0, % run selected test
show/1, % RDF diagram for File
run_test/1 % run a single test
]).
% get libraries locally
:- asserta(user:file_search_path(library, '.')).
:- use_module(rdf). % our RDF parser
:- use_module(rdf_ntriples). % read .nt files
:- load_files([ library(pce),
library(toolbar),
library(pce_report),
rdf_diagram,
library('emacs/emacs')
],
[ silent(true)
]).
:- dynamic
verbose/0.
%verbose.
set_verbose :-
verbose, !.
set_verbose :-
assert(verbose).
:- dynamic
rdf/3.
ns(test,
'http://www.w3.org/2000/10/rdf-tests/rdfcore/testSchema#').
local('http://www.w3.org/2000/10/rdf-tests/rdfcore/',
'W3Ctests/').
process_manifest :-
process_manifest('W3Ctests/Manifest.rdf').
process_manifest(Manifest) :-
retractall(rdf(_,_,_)),
load_rdf(Manifest, Triples),
assert_triples(Triples).
assert_triples([]).
assert_triples([rdf(S, P, O)|T]) :-
canonise(S, Subject),
canonise(P, Predicate),
canonise(O, Object),
assert(rdf(Subject, Predicate, Object)),
assert_triples(T).
canonise(NS:Name, N:Name) :-
ns(N, NS), !.
canonise(Absolute, N:Name) :-
atom(Absolute),
ns(N, NS),
atom_concat(NS, Name, Absolute), !.
canonise(X, X).
run_tests :-
process_manifest,
start_tests,
( rdf(About, rdf:type, test:Type),
\+ rdf(About, test:status, literal('OBSOLETE')),
test_type(Type),
% once(run_test(About)), % Should not be needed
run_test(About),
fail
; true
), !,
report_results.
test_type('PositiveParserTest').
%test_type('NegativeParserTest').
run_test(Test) :-
rdf(Test, test:inputDocument, In),
local_file(In, InFile),
exists_file(InFile),
( load_rdf(InFile, RDF,
[ base_uri(In),
expand_foreach(true)
])
-> true
; RDF = []
),
Data = [ source(InFile),
result(RDF),
norm(NT),
substitutions(Substitions)
],
% there may be alternative output
% documents
( rdf(Test, test:outputDocument, Out),
local_file(Out, NTFile),
load_rdf_ntriples(NTFile, NT),
feedback('Comparing to ~w~n', [NTFile]),
compare_triples(RDF, NT, Substitions)
-> test_result(pass, Test, Data)
% if all fails, display the first
; rdf(Test, test:outputDocument, Out),
local_file(Out, NTFile),
load_rdf_ntriples(NTFile, NT),
Substitions = [],
test_result(fail, Test, Data)
).
local_file(URL, File) :-
local(URLPrefix, FilePrefix),
atom_concat(URLPrefix, Base, URL), !,
atom_concat(FilePrefix, Base, File).
/*******************************
* GUI *
*******************************/
:- pce_begin_class(w3c_rdf_test_gui, frame).
initialise(F, Show:chain) :->
send_super(F, initialise, 'W3C RDF test suite results'),
send(F, append, new(B, browser)),
send(B, hor_stretch, 100),
send(B, hor_shrink, 100),
( send(Show, member, source)
-> new(V, emacs_view(height := 3)),
send(V, name, text)
; true
),
( send(Show, member, result)
-> new(R, rdf_diagram),
send(R, name, result),
send(R, label, 'Result')
; true
),
( send(Show, member, norm)
-> new(N, rdf_diagram),
send(N, name, norm),
send(N, label, 'Norm')
; true
),
stack_windows([V,R,N], _, W),
( nonvar(W)
-> send(W, right, B)
; true
),
send(new(D, tool_dialog(F)), above, B),
send(new(report_dialog), below, B),
send(F, fill_menu, D),
send(F, fill_browser, B).
stack_windows([], L, L).
stack_windows([H|T], W0, W) :-
var(H), !,
stack_windows(T, W0, W).
stack_windows([H|T], W0, W) :-
var(W0), !,
stack_windows(T, H, W).
stack_windows([H|T], WL, W) :-
send(H, below, WL),
stack_windows(T, H, W).
fill_menu(F, D:tool_dialog) :->
send_list(D,
[ append(menu_item(exit, message(F, destroy)),
file)
]).
fill_browser(_F, B:browser) :->
send(B, style, pass, style(colour := dark_green)),
send(B, style, fail, style(colour := red)),
send(B?image, recogniser,
handler(ms_right_down,
and(message(B, selection,
?(B, dict_item, @event)),
new(or)))),
send(B, popup, new(P, popup)),
send(B, select_message, message(@arg1, run)),
send_list(P, append,
[ menu_item(run,
message(@arg1, run)),
menu_item(edit,
message(@arg1, edit_test)),
gap,
menu_item(show_result,
message(@arg1, show_triples, result)),
menu_item(show_norm,
message(@arg1, show_triples, norm)),
gap,
menu_item(discussion,
message(@arg1, open_url, discussion),
condition :=
message(@arg1, has_url, discussion)),
menu_item(approval,
message(@arg1, open_url, approval),
condition :=
message(@arg1, has_url, approval)),
gap,
menu_item(copy_test_uri,
message(@arg1, copy_test_uri))
]).
test_result(F, Result:{pass,fail}, Test:name, Data:prolog) :->
"Test failed"::
get(F, member, browser, B),
( get(B, member, Test, Item)
-> send(Item, object, prolog(Data)),
send(Item, style, Result)
; send(B, append,
rdf_test_item(Test, @default, prolog(Data), Result))
).
clear(F) :->
get(F, member, browser, B),
send(B, clear).
summarise(F) :->
get(F, member, browser, Browser),
new(Pass, number(0)),
new(Fail, number(0)),
send(Browser?members, for_all,
if(@arg1?style == pass,
message(Pass, plus, 1),
message(Fail, plus, 1))),
send(F, report, status, '%d tests succeeded; %d failed',
Pass, Fail).
:- pce_end_class(w3c_rdf_test_gui).
:- pce_begin_class(rdf_test_item, dict_item).
edit_test(Item) :->
"Edit input document of test"::
get(Item, object, List),
member(source(InFile), List),
edit(file(InFile)).
show_triples(Item, Set:{result,norm}) :->
"Show result of our parser"::
get(Item, key, Test),
get(Item, object, List),
Term =.. [Set,Triples],
member(Term, List),
send(Item, show_diagram(Triples,
string('%s for %s', Set?label_name, Test))).
show_diagram(_Item, Triples:prolog, Label:name) :->
"Show diagram for triples"::
new(D, rdf_diagram(Label)),
send(new(report_dialog), below, D),
send(D, triples, Triples),
send(D, open).
open_url(Item, Which:name) :->
"Open associated URL in browser"::
get(Item, key, Test),
rdf(Test, test:Which, URL),
www_open_url(URL).
has_url(Item, Which:name) :->
"Test if item has URL"::
get(Item, key, Test),
rdf(Test, test:Which, _URL).
run(Item) :->
"Re-run the test"::
get(Item, key, Test),
run_test(Test),
send(Item, show).
copy_test_uri(Item) :->
"Copy URI of test to clipboard"::
get(Item, key, Test),
send(@display, copy, Test).
show(Item) :->
"Show source, result and norm diagrams"::
get(Item?image, frame, Frame),
get(Item, object, List),
( get(Frame, member, result, Result)
-> member(result(RTriples), List),
send(Result, triples, RTriples)
; true
),
( get(Frame, member, norm, Norm)
-> member(norm(NTriples), List),
send(Norm, triples, NTriples)
; true
),
( get(Frame, member, text, View)
-> member(source(File), List),
send(View, text_buffer, new(TB, emacs_buffer(File))),
% scroll to RDF text
( member(Pattern, [':RDF', 'RDF']),
get(TB, find, 0, Pattern, Start),
get(TB, scan, Start, line, 0, start, BOL)
-> send(View, scroll_to, BOL, 1)
; true
)
; true
).
% member(substitutions(Substitutions), List),
% send(Result, copy_layout, Norm, Substitutions),
:- pce_end_class(rdf_test_item).
:- pce_global(@rdf_test_gui, make_rdf_test_gui).
make_rdf_test_gui(Ref) :-
send(new(Ref, w3c_rdf_test_gui(chain(source,result))), open).
test_result(Result, Test, Data) :-
send(@rdf_test_gui, test_result, Result, Test, Data),
( Result == fail, verbose
-> member(result(Our), Data),
length(Our, OurLength),
format('~N** Our Triples (~w)~n', OurLength),
pp(Our),
member(norm(Norm), Data),
length(Norm, NormLength),
format('~N** Normative Triples (~w)~n', NormLength),
pp(Norm)
; true
).
start_tests :-
send(@rdf_test_gui, clear).
report_results :-
send(@rdf_test_gui, summarise).
run :-
set_verbose,
get(@rdf_test_gui, member, browser, B),
get(B, selection, DI),
get(DI, key, Test),
run_test(Test).
/*******************************
* SHOW A FILE *
*******************************/
show(File) :-
rdf_diagram_from_file(File).
/*******************************
* COMPARING *
*******************************/
% compare_triples(+PlRDF, +NTRDF, -Substitions)
%
% Compare two models and if they are equal, return a list of
% PlID = NTID, mapping NodeID elements.
compare_triples(A, B, Substitutions) :-
compare_list(A, B, [], Substitutions).
compare_list([], [], S, S).
compare_list(L1, L2, S0, S) :-
take_bag(L1, B1, E1, R1), !,
take_bag(L2, B2, E2, R2),
compare_field(B1, B2, S0, S1),
compare_bags(E1, E2, S1, S2),
compare_list(R1, R2, S2, S).
compare_list([H1|T1], In2, S0, S) :-
select(H2, In2, T2),
compare_triple(H1, H2, S0, S1), % put(.), flush_output,
compare_list(T1, T2, S1, S).
compare_triple(rdf(Subj1,P1,O1), rdf(Subj2, P2, O2), S0, S) :-
compare_field(Subj1, Subj2, S0, S1),
compare_field(P1, P2, S1, S2),
compare_field(O1, O2, S2, S).
compare_field(X, X, S, S) :- !.
compare_field(literal(X), xml(X), S, S) :- !. % TBD
compare_field(rdf:Name, Atom, S, S) :-
atom(Atom),
rdf_parser:rdf_name_space(NS),
atom_concat(NS, Name, Atom), !.
compare_field(NS:Name, Atom, S, S) :-
atom(Atom),
atom_concat(NS, Name, Atom), !.
compare_field(X, node(Id), S, S) :-
memberchk(X=Id, S), !.
compare_field(X, node(Id), S, [X=Id|S]) :-
\+ memberchk(X=_, S),
atom(X),
generated_prefix(Prefix),
sub_atom(X, 0, _, _, Prefix), !,
feedback('Assume ~w = ~w~n', [X, node(Id)]).
generated_prefix(Prefix) :-
rdf_truple:anon_base(Prefix).
% compare_bags(+Members1, +Members2, +S0, -S)
%
% Order of _1, _2, etc. are not relevant in BadID reification. Are
% they in general? Anyway, we'll normalise the order of the bags
compare_bags([], [], S, S).
compare_bags([E1|T1], M, S0, S) :-
select(E2, M, T2),
compare_field(E1, E2, S0, S1),
compare_bags(T1, T2, S1, S).
take_bag(Triples, Bag, Elems, RestTriples) :-
select(rdf(Bag, Type, BagClass), Triples, T1),
compare_field(rdf:type, Type, [], []),
compare_field(rdf:'Bag', BagClass, [], []),
bag_members(T1, Bag, Elems, RestTriples).
bag_members([], _, [], []).
bag_members([rdf(Bag, IsElm, E)|T], Bag, [E|ET], Rest) :-
member_prop(IsElm), !,
bag_members(T, Bag, ET, Rest).
bag_members([T0|T], Bag, Elems, [T0|R]) :-
bag_members(T, Bag, Elems, R).
member_prop(rdf:Name) :-
atom_codes(Name, [0'_|Codes]),
number_codes(_N, Codes), !.
member_prop(Prop) :-
atom(Prop),
rdf_parser:rdf_name_space(NS),
atom_concat(NS, Name, Prop),
atom_codes(Name, [0'_|Codes]),
number_codes(_N, Codes), !.
% feedback(+Format, +Args)
%
% Print if verbose
feedback(Fmt, Args) :-
verbose, !,
format(user_error, Fmt, Args).
feedback(_, _).