/* Part of SWI-Prolog Author: Jan Wielemaker E-mail: J.Wielemaker@vu.nl WWW: http://www.swi-prolog.org Copyright (c) 2009-2016, University of Amsterdam VU University Amsterdam All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ :- module(test_rdf_db, [ test_rdf_db/0 ]). :- include(local_test). :- use_module(library(semweb/rdf_db)). :- use_module(library(semweb/rdfs)). :- use_module(library(xsdp_types)). :- use_module(library(lists)). :- use_module(library(plunit)). :- use_module(library(debug)). :- discontiguous term_expansion/2. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RDF-DB test file. A test is a clause of the form: (-) :- Body. If the body fails, an appropriate error message is printed. So, all goals are supposed to succeed. The predicate testset/1 defines the available test sets. The public goals are: ?- runtest(+TestSet). ?- test. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ test_rdf_db :- test, run_tests([ lang_matches, lit_ranges, num_ranges, rdf_prefix ]). test_input(Name, Path) :- source_file(test_rdf_db, MyFile), file_directory_name(MyFile, MyDir), atomic_list_concat([MyDir, Name], /, Path). /******************************* * TEST DATA * *******************************/ data(string, ''). data(string, 'This is a nice string'). data(string, '\u0411\u0435\u0441\u043f\u043b\u0430\u0442\u043d\u0430\u044f'). data(int, 0). data(int, -67). data(int, 327848). data(float, 0.0). data(float, 48.25). data(term, [let, us, test, a, list]). data(term, [let, us, test, another, list]). /******************************* * LOAD/SAVE * *******************************/ save_reload_db :- tmp_file(rdf, File), rdf_save_db(File), rdf_reset_db, rdf_load_db(File), delete_file(File). save_reload :- tmp_file(rdf, File), rdf_save(File), rdf_reset_db, rdf_load(File, [ base_uri([]), % do not qualify convert_typed_literal(convert_typed), format(xml) ]), delete_file(File). save_reload(Encoding) :- tmp_file(rdf, File), rdf_save(File, [encoding(Encoding)]), rdf_reset_db, rdf_load(File, [ base_uri([]), % do not qualify convert_typed_literal(convert_typed), format(xml) ]), delete_file(File). % convert_typed(+Type, +Content, -Object) % % Convert to type(Type, PrologValue), providing the inverse of % the default RDF as produced by rdf_db.pl convert_typed(Type, Content, type(Type, Value)) :- xsdp_convert(Type, Content, Value). /******************************* * RESOURCE * *******************************/ resource(1) :- rdf_assert(x, a, aap), rdf_assert(x, a, noot), findall(X, rdf(x, a, X), L), L == [aap, noot]. /******************************* * SIMPLE LITERAL * *******************************/ literal(1) :- findall(V, data(_, V), Vs), forall(member(Value, Vs), rdf_assert(x, a, literal(Value))), findall(V, (rdf(x, a, X), X = literal(V)), V2), V2 == Vs. literal(2) :- rdf_assert(x, a, literal(plain)), rdf(x, a, literal(type(xsd:string, Plain))), Plain == plain, rdf(x, a, literal(type(xsd:string, plain))). /******************************* * UNIFYING ARGS * *******************************/ same(1) :- rdf_assert(a,b,c), rdf_assert(x,x,x), rdf(X,X,X), X == x. /******************************* * TYPED LITERALS * *******************************/ typed(1) :- findall(type(T,V), data(T, V), TVs), forall(member(Value, TVs), rdf_assert(x, a, literal(Value))), findall(V, (rdf(x, a, X), X = literal(V)), V2), V2 == TVs. typed(2) :- findall(type(T,V), data(T, V), TVs), forall(member(Value, TVs), rdf_assert(x, a, literal(Value))), findall(V, rdf(x, a, literal(V)), V2), V2 == TVs. typed(3) :- findall(type(T,V), data(T, V), TVs), forall(member(Value, TVs), rdf_assert(x, a, literal(Value))), X = type(T,V), findall(X, rdf(x, a, literal(X)), TV2), TV2 == TVs. typed(save_db) :- findall(type(T,V), data(T, V), TVs), forall(member(Value, TVs), rdf_assert(x, a, literal(Value))), save_reload_db, X = type(T,V), findall(X, rdf(x, a, literal(X)), TV2), TV2 == TVs. typed(save) :- findall(type(T,V), ( data(T, V), T \== term, V \== '' ), TVs), forall(member(Value, TVs), rdf_assert(x, a, literal(Value))), save_reload, findall(X, rdf(x, a, literal(X)), TV2), ( same_set(TV2, TVs) -> true ; format('TV2 = ~q~n', [TV2]), fail ). typed(match) :- rdf_assert(x, a, literal(c)), \+ rdf(x, a, literal(type(t, c))), \+ rdf(x, a, literal(type(t, _))). typed(match_lang) :- rdf_assert(x, a, literal(lang(en, 'hello'))), rdf_retractall(_,_,literal(lang(nl, _))), rdf(x,a,literal(lang(en, 'hello'))). typed(convert) :- rdf_literal_value(literal(type(xsd:integer, '42')), 42). /******************************* * XML:LANG HANDLING * *******************************/ lang_data :- lang_data(x, a). lang_data(S, A) :- rdf_assert(S, A, literal(lang(nl, 'Jan'))), rdf_assert(S, A, literal(lang(en, 'John'))), rdf_assert(S, A, literal(lang(en, ''))), rdf_assert(S, A, literal('Johannes')). same_set(S1, S2) :- sort(S1, Sorted1), sort(S2, Sorted2), Sorted1 =@= Sorted2. lang(1) :- lang_data, findall(X, rdf(x, a, literal(X)), Xs), Xs == [ lang(nl, 'Jan'), lang(en, 'John'), lang(en, ''), 'Johannes' ]. lang(2) :- lang_data, findall(X, rdf(x, a, literal(lang(nl, X))), Xs), Xs == [ 'Jan' ]. lang(3) :- lang_data, X = lang(_,_), findall(X, rdf(x, a, literal(X)), Xs), Xs =@= [ lang(nl, 'Jan'), lang(en, 'John'), lang(en, ''), lang(_, 'Johannes') ]. lang(4) :- lang_data, rdf(S, P, literal('Jan')), S == x, P == a, rdf(S, P, literal('Johannes')), S == x, P == a. lang(save_db) :- lang_data, save_reload_db, X = lang(_,_), findall(X, rdf(x, a, literal(X)), Xs), ( Xs =@= [ lang(nl, 'Jan'), lang(en, 'John'), lang(en, ''), lang(_, 'Johannes') ] -> true ; format(user_error, 'Xs = ~w~n', [Xs]), fail ). lang(save) :- lang_data, save_reload, findall(X, rdf(x, a, literal(X)), Xs), ( same_set(Xs, [ lang(nl, 'Jan'), lang(en, 'John'), lang(en, ''), 'Johannes' ]) -> true ; format(user_error, 'Xs = ~q~n', [Xs]), fail ). /******************************* * NAMESPACES * *******************************/ term_expansion(ns_data(S0,P0,O0), ns_data(S,P,O)) :- rdf_global_id(S0, S), rdf_global_id(P0, P), rdf_global_id(O0, O). :- rdf_register_ns(dynamic, 'http://www.dynamic.org/'). ns_data(x, rdf:type, rdf:is). ns_data(y, rdf:type, rdf:(dynamic)). ns_data(z, rdf:type, (dynamic):rdf). ns_data(z, (dynamic):attr1, literal(dynamic)). ns_data(z, (dynamic):attr2, (dynamic):rdf). namespace(save) :- findall(rdf(S,P,O), ns_data(S,P,O), Triples), forall(member(rdf(S,P,O), Triples), rdf_assert(S,P,O)), save_reload, findall(rdf(S,P,O), rdf(S,P,O), NewTriples), ( same_set(Triples, NewTriples) -> true ; format(user_error, 'NewTriples = ~q~n', [NewTriples]), fail ). /******************************* * LITERAL SHARING * *******************************/ lshare(1) :- rdf_assert(a,b,literal(aap)), rdf_statistics(literals(1)). lshare(2) :- rdf_assert(a,b,literal(aap)), rdf_retractall(a,b,literal(aap)), assertion(no_literals). lshare(3) :- rdf_assert(a,b,literal(aap)), rdf_assert(a,c,literal(aap)), % shared rdf_statistics(literals(1)). lshare(4) :- rdf_assert(a,b,literal(aap)), rdf_assert(a,c,literal(aap)), rdf_retractall(a,b,literal(aap)), rdf_retractall(a,c,literal(aap)), assertion(no_literals). lshare(5) :- rdf_assert(a,b,literal(aap), g1), rdf_assert(a,b,literal(aap), g2), rdf_statistics(literals(X1)), assertion(X1 == 1), rdf_retractall(a,b,literal(aap)), assertion(no_literals). %! no_literals % % We may have to wait a little because the automatic garbage % collector did the work asynchronously and we still get the old % value. no_literals :- rdf_gc, ( rdf_statistics(literals(0)) -> true ; %writeln('Retrying'), between(1, 10, _), sleep(0.01), rdf_statistics(literals(0)) ). /******************************* * WIDE CHARACTERS * *******************************/ wide_atom(A) :- atom_codes(A, [97, 1080, 1081]). wide(iso-object-resource) :- wide_atom(A), rdf_assert(aap, noot, A), save_reload(iso_latin_1). wide(utf8-object-resource) :- wide_atom(A), rdf_assert(aap, noot, A), save_reload(utf8). wide(iso-object-literal) :- wide_atom(A), rdf_assert(aap, noot, literal(A)), save_reload(iso_latin_1). wide(utf8-object-literal) :- wide_atom(A), rdf_assert(aap, noot, literal(A)), save_reload(utf8). %wide(iso-predicate) :- Requires XML UTF-8 names. % wide_atom(A), % rdf_assert(aap, A, noot), % save_reload(iso_latin_1). %wide(utf8-predicate) :- % wide_atom(A), % rdf_assert(aap, A, noot), % save_reload(utf8). wide(iso-subject) :- wide_atom(A), rdf_assert(A, aap, noot), save_reload(iso_latin_1). wide(utf8-subject) :- wide_atom(A), rdf_assert(A, aap, noot), save_reload(utf8). wide(db-object-literal) :- wide_atom(A), rdf_assert(aap, noot, literal(A)), save_reload_db. /******************************* * UPDATE * *******************************/ update(subject) :- rdf_assert(x, a, v), rdf_update(x, a, v, subject(y)), rdf(y, a, v). update(predicate) :- rdf_assert(x, a, v), rdf_update(x, a, v, predicate(b)), rdf(x, b, v). update(object-1) :- rdf_assert(x, a, v), rdf_update(x, a, v, object(w)), rdf(x, a, w). update(object-2) :- rdf_assert(x, a, v), rdf_update(x, a, v, object(literal(hello))), rdf(x, a, literal(hello)). update(object-3) :- rdf_assert(x, a, v), rdf_update(x, a, v, object(literal(lang(nl, hallo)))), rdf(x, a, literal(lang(nl, hallo))). update(object-4) :- % add lang rdf_assert(x, a, literal(hallo)), rdf_update(x, a, literal(hallo), object(literal(lang(nl, hallo)))), rdf(x, a, literal(lang(nl, hallo))). update(object-5) :- % only change lang rdf_assert(x, a, literal(lang(en, hallo))), rdf_update(x, a, literal(lang(en, hallo)), object(literal(lang(nl, hallo)))), rdf(x, a, literal(lang(nl, hallo))). update(object-6) :- % drop lang rdf_assert(x, a, literal(lang(en, hallo))), rdf_update(x, a, literal(lang(en, hallo)), object(literal(hallo))), rdf(x, a, literal(hallo)). update(object-7) :- % transaction update rdf_assert(x, a, literal(lang(en, hallo))), rdf_transaction(rdf_update(x, a, literal(lang(en, hallo)), object(literal(hallo)))), rdf(x, a, literal(hallo)). update(literal) :- rdf_assert(s1, p, literal(xxx)), rdf_assert(s2, p, literal(xxx)), rdf_update(s1, p, literal(xxx), subject(s3)), rdf(s3, p, literal(xxx)). /******************************* * TRANSACTIONS * *******************************/ transaction(empty-1) :- rdf_transaction(true), findall(rdf(S,P,O), rdf(S,P,O), L), L == []. transaction(assert-1) :- rdf_transaction(rdf_assert(x, a, v)), findall(rdf(S,P,O), rdf(S,P,O), L), L == [ rdf(x, a, v) ]. transaction(assert-2) :- \+ rdf_transaction((rdf_assert(x, a, v), fail)), findall(rdf(S,P,O), rdf(S,P,O), L), L == []. transaction(nest-1) :- rdf_transaction( ( rdf_assert(x, a, v), rdf_transaction(rdf_assert(x, a, v2)))), findall(rdf(S,P,O), rdf(S,P,O), L), L == [ rdf(x, a, v), rdf(x, a, v2) ]. transaction(nest-2) :- rdf_transaction( ( rdf_assert(x, a, v), \+ rdf_transaction((rdf_assert(x, a, v2),fail)))), findall(rdf(S,P,O), rdf(S,P,O), L), L == [ rdf(x, a, v) ]. transaction(nest-3) :- rdf_assert(s1,p1,o1), rdf_transaction( ( rdf_assert(s2,p2,o2), rdf_transaction(rdf_retractall(_,_,_), _, [snapshot(true)]), findall(rdf(S,P,O), rdf(S,P,O), L) )), L == [ rdf(s1,p1,o1), rdf(s2,p2,o2) ]. transaction(nest-3) :- rdf_assert(s1,p1,o1), rdf_transaction( ( rdf_assert(s2,p2,o2), rdf_transaction(rdf_assert(s3,p3,o3), _, [snapshot(true)]), findall(rdf(S,P,O), rdf(S,P,O), L) )), L == [ rdf(s1,p1,o1), rdf(s2,p2,o2) ]. transaction(deadlock-1) :- rdf_assert(x,y,z,g), rdf_assert(x,y,z,g), rdf_transaction(rdf(_S, _P, _O, _G)). transaction(deadlock-2) :- tmp_file(rdf, F1), tmp_file(rdf, F2), rdf_assert(a, b, c, f1), rdf_assert(x, y, z, f2), rdf_save_db(F1, f1), rdf_save_db(F2, f2), rdf_reset_db, rdf_assert(l, f, F1), rdf_assert(l, f, F2), rdf_transaction(forall(rdf(l, f, F), rdf_load_db(F))), findall(rdf(S,P,O), rdf(S,P,O), L), L == [ rdf(l,f,F1), rdf(l,f,F2), rdf(a,b,c), rdf(x,y,z) ], delete_file(F1), delete_file(F2). transaction(active-1) :- \+ rdf_active_transaction(_). transaction(active-2) :- rdf_transaction(rdf_active_transaction(x), x). transaction(active-3) :- rdf_transaction(findall(X, rdf_active_transaction(X), Xs), x), Xs == [x]. transaction(active-4) :- rdf_transaction(rdf_active_transaction(Y), X), X == Y. transaction(active-5) :- rdf_transaction(rdf_active_transaction(x), X), X == x. /******************************* * LABELS * *******************************/ label(1) :- rdf_global_id(rdfs:label, Label), lang_data(x, Label), findall(L, rdfs_label(x, L), Ls), Ls = ['Jan', 'John', '', 'Johannes']. label(2) :- rdf_global_id(rdfs:label, Label), lang_data(x, Label), findall(L, rdfs_label(x, en, L), Ls), Ls = ['John', '']. /******************************* * MATCH * *******************************/ match(1) :- rdf_assert(a,b,literal('hello there world!')), rdf(a,b,literal(substring('llo'), _)). match(2) :- rdf_assert(a,b,literal('hello there world!')), rdf(a,b,literal(word('there'), _)). match(3) :- rdf_assert(a,b,literal('hello there world!')), rdf(a,b,literal(word('hello'), _)). match(4) :- rdf_assert(a,b,literal('hello there world!')), rdf(a,b,literal(word('world'), _)). match(5) :- rdf_assert(a,b,literal('hello there world!')), rdf(a,b,literal(like('*there*'), _)). match(6) :- rdf_assert(a,b,literal('hello there world!')), rdf(a,b,literal(like('*world!*'), _)). match(7) :- % test backtracking rdf_assert(a,b,literal('hello there world there universe!')), rdf(a,b,literal(like('*th*uni*'), _)). /******************************* * PREFIX * *******************************/ prefix_data(s, p1, aaaaa). prefix_data(s, p1, aaaab). prefix_data(s, p1, aaabb). prefix_data(s, p1, aaacc). prefix_data(s, p1, aaccc). prefix_data(s, p1, adddd). prefix_data(s, p2, 'BBBBB'). prefix_data(s, p2, 'bbbbb'). prefix_data(s, p2, 'bbbcc'). prefix_data(s, p2, 'BBBcc'). mkprefix_db(P) :- forall(prefix_data(S,P,O), rdf_assert(S, P, literal(O))). tprefix(P, Prefix) :- mkprefix_db(P), findall(rdf(A,P,L), rdf(A,P,literal(prefix(Prefix), L)), List), findall(rdf(A,P,L), ( prefix_data(A,P,L), case_prefix(Prefix, L) ), L2), % writeln(List), L2 == List. case_prefix(Prefix, Atom) :- atom_codes(Prefix, PC), atom_codes(Atom, AC), prefix_codes(PC, AC). prefix_codes([], _). prefix_codes([H0|T0], [H|T]) :- code_type(L, to_lower(H0)), code_type(L, to_lower(H)), prefix_codes(T0, T). prefix(1) :- tprefix(p1, ''). prefix(2) :- tprefix(p1, a). prefix(3) :- tprefix(p1, aa). prefix(4) :- tprefix(p1, aaa). prefix(5) :- tprefix(p1, aaaa). prefix(6) :- tprefix(p1, aaaaa). prefix(7) :- tprefix(p2, bbbb). prefix(8) :- tprefix(p2, bbbbb). prefix(9) :- tprefix(p2, 'Bbbbb'). prefix(10) :- tprefix(p2, 'BBBBB'). prefix(like-1) :- mkprefix_db(_), findall(L, rdf(_,_,literal(like('a*b'), L)), Ls), Ls = [aaaab, aaabb]. /******************************* * RETRACTALL * *******************************/ rdf_retractall(nopred-1) :- rdf_retractall(aap, noot, mies). rdf_retractall(term) :- rdf_assert(a, b, literal(x)), rdf_assert(a, b, literal(x(1))), rdf_retractall(a, b, literal(x(_))), findall(V, rdf(a,b,V), [literal(x)]). /******************************* * MONITOR * *******************************/ %do_monitor(Event) :- % writeln(Event), fail. do_monitor(assert(S, P, O, DB)) :- atom(O), ip(P, IP), rdf_transaction(rdf_assert(O, IP, S, DB)). do_monitor(retract(S, P, O, DB)) :- atom(O), ip(P, IP), rdf_transaction(rdf_retractall(O, IP, S, DB)). ip(a, ia). ip(b, ib). monitor(transaction-1) :- rdf_reset_db, rdf_monitor(do_monitor, []), rdf_transaction(rdf_assert(x, a, y, db)), rdf_monitor(do_monitor, [-all]), findall(rdf(S,P,O), rdf(S,P,O), DB), assertion(DB == [ rdf(x, a, y), rdf(y, ia, x) ]), rdf_monitor(do_monitor, []), rdf_transaction(rdf_retractall(x, a, y, db)), rdf_monitor(do_monitor, [-all]), assertion(\+rdf(_,_,_)). /******************************* * SUB-PROPERTY * *******************************/ subproperty(1) :- rdf_assert(a, p, b), \+ rdf_has(_, p2, b, _). subproperty(2) :- rdf_assert(s, p, o), rdf_has(s,P,o), P == p. subproperty(3) :- rdf_assert(s, p, o), rdf_assert(p, rdfs:subPropertyOf, sp), rdf_has(s,sp,o). subproperty(4) :- rdf_assert(s, p, o), rdf_assert(p, rdfs:subPropertyOf, sp), rdf_has(s,sp,o,P), P == p. subproperty(5) :- rdf_assert(s, p, o), rdf_assert(p, rdfs:subPropertyOf, sp), rdf_set_predicate(sp, inverse_of(ip)), rdf_has(o,ip,s,P), P == inverse_of(p). /******************************* * INVERSE * *******************************/ inverse(1) :- rdf_assert(s, p, o), rdf_set_predicate(p, inverse_of(ip)), findall(O-S, rdf_has(O, ip, S), List), List == [o-s]. /******************************* * PROPERTY HIERACHY * *******************************/ %! ptree(+Id) % % Property hierarchy handling for rdf_has/3. The routines maintain % clouds of connected properties and for each cloud a bitmatrix % filled with the closure of the rdfs:subPropertyOf relation. % % @tbd: improve tests by trying all permutations of the order in % which the graph is built. ptree(1) :- rdf_assert(a, rdfs:subPropertyOf, b), rdf_assert(x, a, y), rdf_has(x, b, y). ptree(2) :- % simple cycle rdf_assert(a, rdfs:subPropertyOf, b), rdf_assert(b, rdfs:subPropertyOf, a), rdf_assert(x, a, y), rdf_has(x, b, y). ptree(3) :- % self-cycle rdf_assert(a, rdfs:subPropertyOf, a), rdf_assert(x, a, y), rdf_has(x, a, y). ptree(4) :- % two roots rdf_assert(c, rdfs:subPropertyOf, b), rdf_assert(c, rdfs:subPropertyOf, d), rdf_assert(x, c, y), rdf_has(x, b, y), rdf_has(x, d, y). ptree(5) :- % two roots, 2nd leg rdf_assert(c, rdfs:subPropertyOf, b), rdf_assert(c, rdfs:subPropertyOf, d), rdf_assert(a, rdfs:subPropertyOf, b), rdf_assert(x, c, y), rdf_assert(x, a, z), rdf_has(x, b, y), rdf_has(x, d, y), rdf_has(x, b, z), \+ rdf_has(x, d, z). ptree(6) :- % two root cycles rdf_assert(c, rdfs:subPropertyOf, b), rdf_assert(c, rdfs:subPropertyOf, d), rdf_assert(b, rdfs:subPropertyOf, bc), rdf_assert(bc, rdfs:subPropertyOf, b), rdf_assert(d, rdfs:subPropertyOf, dc), rdf_assert(dc, rdfs:subPropertyOf, d), rdf_assert(x, c, y), rdf_has(x, b, y), rdf_has(x, d, y), rdf_has(x, dc, y), rdf_has(x, bc, y). ptree(7) :- % create and break the cycles rdf_assert(x, a, y), rdf_assert(a, rdfs:subPropertyOf, b), rdf_retractall(a, rdfs:subPropertyOf, b), \+ rdf_has(x, b, y). /******************************* * REACHABLE * *******************************/ graph(a, p, b). graph(b, p, c). graph(c, p, d). graph(b, p, d). graph(e, p, d). graph(Symmetric) :- rdf_set_predicate(p, symmetric(Symmetric)), forall(graph(S,P,O), rdf_assert(S,P,O)). reachable(1) :- rdf_reachable(a, x, a). reachable(2) :- graph(false), rdf_reachable(a, p, d). reachable(3) :- graph(false), rdf_reachable(a, p, X), X == c, !. reachable(4) :- graph(false), findall(O, rdf_reachable(a, p, O), Os), Os = [a,b,c,d]. reachable(5) :- graph(false), \+ rdf_reachable(d, p, a). reachable(6) :- graph(true), rdf_reachable(d, p, a). reachable(6) :- graph(true), rdf_reachable(e, p, a). /******************************* * DUPLICATES * *******************************/ duplicates(1) :- rdf_assert(a, b, literal(lang(en, l))), rdf_assert(a, b, literal(l)), rdf_retractall(a, b, literal(lang(en, l))). /******************************* * SOURCE * *******************************/ source(1) :- rdf_assert(a,b,c,test), get_time(Now), rdf_db:rdf_set_graph_source(test, 'test.rdf', Now), rdf_source(test, X), X == 'test.rdf'. source(2) :- rdf_assert(s,p,o,test), rdf_graph_property(test, hash(MD5a)), rdf_unload_graph(test), rdf_assert(s,p,o,test), rdf_graph_property(test, hash(MD5z)), assertion(MD5a == MD5z). source(3) :- rdf_assert(s,p,o,g), assertion(rdf_statistics(graphs(1))), rdf_unload_graph(g), assertion(rdf_statistics(graphs(0))), rdf_assert(s,p,o,g), assertion(rdf_statistics(graphs(1))). /******************************* * RETRACT * *******************************/ delete(1) :- rdf_assert(s,p,o), rdf_retractall(s,p,o), rdf_statistics(triples(Count)), assertion(Count == 0). delete(2) :- rdf_assert(s,p,o), rdf_transaction(rdf_retractall(s,p,o)), rdf_statistics(triples(Count)), assertion(Count == 0). delete(3) :- rdf_transaction(rdf_assert(s,p,o)), rdf_transaction(rdf_retractall(s,p,o)), rdf_transaction(rdf_assert(s,p,o)), rdf_statistics(triples(Count)), assertion(Count == 1). /******************************* * UNLOAD * *******************************/ unload(1) :- test_input('dc.rdfs', File), rdf_load(File), rdf_statistics(triples(T0)), rdf_unload(File), rdf_statistics(triples(T1)), rdf_load(File), rdf_statistics(triples(T2)), assertion(T0 == T2), assertion(T1 == 0). /******************************* * INDEXES * *******************************/ warm(1) :- rdf_warm_indexes. /******************************* * SCRIPTS * *******************************/ :- dynamic script_dir/1. set_script_dir :- script_dir(_), !. set_script_dir :- find_script_dir(Dir), assert(script_dir(Dir)). find_script_dir(Dir) :- prolog_load_context(file, File), follow_links(File, RealFile), file_directory_name(RealFile, Dir). follow_links(File, RealFile) :- read_link(File, _, RealFile), !. follow_links(File, File). :- set_script_dir. run_test_script(Script) :- file_base_name(Script, Base), file_name_extension(Pred, _, Base), load_files(Script, [silent(true)]), Pred. run_test_scripts(Directory) :- ( script_dir(ScriptDir), atomic_list_concat([ScriptDir, /, Directory], Dir), exists_directory(Dir) -> true ; Dir = Directory ), atom_concat(Dir, '/*.pl', Pattern), expand_file_name(Pattern, Files), file_base_name(Dir, BaseDir), format('Running scripts from ~w ', [BaseDir]), flush, run_scripts(Files), format(' done~n'). run_scripts([]). run_scripts([H|T]) :- ( catch(run_test_script(H), Except, true) -> ( var(Except) -> put(.), flush ; Except = blocked(Reason) -> assert(blocked(H, Reason)), put(!), flush ; script_failed(H, Except) ) ; script_failed(H, fail) ), run_scripts(T). script_failed(File, fail) :- format('~NScript ~w failed~n', [File]), assert(failed(script(File))). script_failed(File, Except) :- message_to_string(Except, Error), format('~NScript ~w failed: ~w~n', [File, Error]), assert(failed(script(File))). /******************************* * TEST MAIN-LOOP * *******************************/ testset(resource). testset(literal). testset(lshare). testset(same). testset(typed). testset(lang). testset(wide). testset(namespace). testset(update). testset(transaction). testset(label). testset(match). testset(prefix). testset(rdf_retractall). testset(monitor). testset(subproperty). testset(inverse). testset(ptree). testset(reachable). testset(duplicates). testset(source). testset(delete). testset(unload). testset(warm). % testdir(Dir) % % Enumerate directories holding tests. testdir('Tests'). :- dynamic failed/1, blocked/2. watch(_). test :- retractall(failed(_)), retractall(blocked(_,_)), rdf_monitor(watch, []), % check consistency forall(testset(Set), runtest(Set)), scripts, % statistics, report_blocked, report_failed. scripts :- forall(testdir(Dir), run_test_scripts(Dir)). report_blocked :- findall(Head-Reason, blocked(Head, Reason), L), ( L \== [] -> format('~nThe following tests are blocked:~n', []), ( member(Head-Reason, L), format(' ~p~t~40|~w~n', [Head, Reason]), fail ; true ) ; true ). report_failed :- findall(X, failed(X), L), length(L, Len), ( Len > 0 -> format('~n*** ~w tests failed ***~n', [Len]), fail ; format('~nAll tests passed~n', []) ). runtest(Name) :- format('Running test set "~w" ', [Name]), flush, functor(Head, Name, 1), nth_clause(Head, _N, R), clause(Head, _, R), rdf_reset_db, % reset before each script ( catch(Head, Except, true) -> ( var(Except) -> put(.), flush ; Except = blocked(Reason) -> assert(blocked(Head, Reason)), put(!), flush ; test_failed(R, Except) ) ; test_failed(R, fail) ), fail. runtest(_) :- format(' done.~n'). test_failed(R, Except) :- clause(Head, _, R), functor(Head, Name, 1), arg(1, Head, TestName), clause_property(R, line_count(Line)), clause_property(R, file(File)), ( Except == fail -> format('~N~w:~d: Test ~w(~w) failed~n', [File, Line, Name, TestName]) ; message_to_string(Except, Error), format('~N~w:~d: Test ~w(~w):~n~t~8|ERROR: ~w~n', [File, Line, Name, TestName, Error]) ), assert(failed(Head)). blocked(Reason) :- throw(blocked(Reason)). /******************************* * UNIT TESTS * *******************************/ :- begin_tests(lang_matches). test(lang_matches, true) :- lang_matches('EN', en). test(lang_matches, true) :- lang_matches(en, 'EN'). test(lang_matches, fail) :- lang_matches(nl, 'EN'). test(lang_matches, true) :- lang_matches('en-GB', en). test(lang_matches, fail) :- lang_matches('en-GB', 'en-*-x'). test(lang_matches, true) :- lang_matches('en-GB-x', 'en-*-x'). test(lang_matches, true) :- lang_matches('en-GB-x-y', 'en-*-x-*'). test(lang_matches, true) :- lang_matches('en-GB-x-y', 'en-*-y'). :- end_tests(lang_matches). /******************************* * LITERAL RANGES * *******************************/ :- begin_tests(lit_ranges, [cleanup(rdf_reset_db)]). letters :- rdf_reset_db, forall(between(0'a, 0'z, X), ( char_code(C, X), rdf_assert(a,b,literal(C)) )). integers :- rdf_reset_db, forall(between(0, 9, X), rdf_assert(a,b,literal(X))). ge(S, X) :- rdf(_,b,literal(ge(S),X)). le(S, X) :- rdf(_,b,literal(le(S),X)). bt(L,H,X) :- rdf(_,b,literal(between(L,H),X)). test(ge, [setup(letters), cleanup(rdf_reset_db), all(X==[x,y,z])]) :- ge(x, X). test(le, [setup(letters), cleanup(rdf_reset_db), all(X==[a,b,c,d,e])]) :- le(e, X). test(bt, [setup(letters), cleanup(rdf_reset_db), all(X==[m,n,o,p])]) :- bt(m, p, X). test(ge, [setup(integers), cleanup(rdf_reset_db), all(X==[4,5,6,7,8,9])]) :- ge(4, X). test(le, [setup(integers), cleanup(rdf_reset_db), all(X==[0,1,2,3])]) :- le(3, X). test(bt, [setup(integers), cleanup(rdf_reset_db), all(X==[6,7,8])]) :- bt(6,8, X). :- end_tests(lit_ranges). /******************************* * NUMERICAL RANGES * *******************************/ term_expansion(In, Out) :- rdf_global_term(In, Out). num(xsd:byte, '10'). num(xsd:integer, '10'). num(xsd:integer, '12'). num(xsd:double, '10.0E0'). num(xsd:double, '1.5E1'). num(xsd:string, '10'). num_data :- forall(num(Type, Lex), rdf_assert(s,p,literal(type(Type,Lex)))). :- begin_tests(num_ranges, [setup(num_data), cleanup(rdf_reset_db)]). test(eq, set(L == [ type(xsd:byte,'10'), type(xsd:integer,'10'), type(xsd:double,'10.0E0')])) :- rdf(s,p,literal(eq(type(xsd:integer, '10')), L)). test(eq, set(L == [ type(xsd:byte,'10'), type(xsd:integer,'10'), type(xsd:double,'10.0E0')])) :- rdf(_,_,literal(eq(type(xsd:integer, '10')), L)). test(gt, set(L == [ type(xsd:integer,'12'), type(xsd:double,'1.5E1')])) :- rdf(s,p,literal(gt(type(xsd:integer, '11')), L)). test(gt, set(L == [ type(xsd:integer,'12'), type(xsd:double,'1.5E1')])) :- rdf(_,_,literal(gt(type(xsd:integer, '11')), L)). :- end_tests(num_ranges). /******************************* * DYNAMIC PREFIX EXPANSION * *******************************/ prefix(I, Alias, URI) :- atom_concat(prefix, I, Alias), atomic_list_concat(['http://www.example.com/', I, '/'], URI). setup_prefixes(N) :- rdf_reset_db, forall(between(1, N, I), ( prefix(I, Alias, URI), rdf_register_prefix(Alias, URI) )). :- begin_tests(rdf_prefix, [setup(setup_prefixes(100)), cleanup(rdf_reset_db)]). test(prefix, true) :- S = rdf:s, P = rdf:p1, O = rdf:o, rdf_assert(S,P,O), assertion(rdf(S,P,O)). test(prefix, L==literal(type('http://www.w3.org/2001/XMLSchema#integer','42'))):- S = rdf:s, P = rdf:p2, T=xsd:integer, rdf_assert(S,P,literal(type(T, '42'))), rdf(S,P,L). test(scale) :- N = 100, forall(between(1, N, I), ( prefix(I, Alias, _URI), S = Alias:s, P = Alias:p, O = Alias:o, rdf_assert(S,P,O))), forall(between(1, N, I), ( prefix(I, _Alias, URI), atom_concat(URI, s, S), atom_concat(URI, p, P), atom_concat(URI, o, O), assertion(rdf(S,P,O)))). test(type, error(existence_error(rdf_prefix, p))) :- P = p:n, rdf_retractall(_, P, _). :- end_tests(rdf_prefix).