/* 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:
<TestSet>(<Name>-<Number>) :- 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).