diff options
author | arie <arie@alleycat.cc> | 2021-06-08 11:14:52 +0200 |
---|---|---|
committer | arie <arie@alleycat.cc> | 2021-06-28 21:02:45 +0200 |
commit | 87ac72ad5621c0a6358ee486e4610c82ece9fb30 (patch) | |
tree | 657dbab96387b884718355aa9bd75744981187bd | |
parent | 6fd93f6259c4723471aacdaebec627d60b710894 (diff) |
Rdf turtle tests:
Add some more complicated tests. Update some parsers. Include a
few print statements (for testing, they will be removed later).
-rw-r--r-- | lib/turtle/rdf_turtle.ml | 38 | ||||
-rw-r--r-- | lib/turtle/rdf_turtle.mli | 4 | ||||
-rw-r--r-- | test/turtle/main.ml | 54 |
3 files changed, 63 insertions, 33 deletions
diff --git a/lib/turtle/rdf_turtle.ml b/lib/turtle/rdf_turtle.ml index 644b33f..1425307 100644 --- a/lib/turtle/rdf_turtle.ml +++ b/lib/turtle/rdf_turtle.ml @@ -185,7 +185,7 @@ module AST = struct Sub_iri of Iri.t | Sub_blank_node of Blank_node.t | Sub_coll of collection - and bnodeps = BNodePs of predobjs + and bnodeps = BnodPs of predobjs and predobjs = (Predicate.t * object' list) list let rec object_equal a b = @@ -204,7 +204,7 @@ module AST = struct | Sub_blank_node ba, Sub_blank_node bb -> Blank_node.equal ba bb | Sub_coll ca, Sub_coll cb -> collection_equal ca cb | _ -> false - and bnodeps_equal (BNodePs a) (BNodePs b) = + and bnodeps_equal (BnodPs a) (BnodPs b) = predobjs_equal a b and predobjs_equal a b = list_equal @@ -223,7 +223,7 @@ module AST = struct | Sub_iri iri ->Fmt.pf ppf "@[<h 1><obj_iri@ %a>@]" Iri.pp iri | Sub_blank_node bnode -> Fmt.pf ppf "@[<h 1><obj_blank_node@ %a>@]" Blank_node.pp bnode | Sub_coll collection -> Fmt.pf ppf "@[<h 1><obj_collection@ %a>@]" collection_pp collection - and bnodeps_pp ppf (BNodePs predobjs) = + and bnodeps_pp ppf (BnodPs predobjs) = Fmt.pf ppf "@[<h 1><obj_bnodeps@ %a>@]" predobjs_pp predobjs and predobjs_pp ppf l = let objlist_pp ppf l = @@ -241,13 +241,13 @@ module AST = struct module Triples = struct type t = SubjPredObjs of subject * predobjs - | BNodePs of bnodeps + | BnodPs of bnodeps let equal a b = match a, b with | SubjPredObjs (asub, ap), SubjPredObjs (bsub, bp) -> subject_equal asub bsub && predobjs_equal ap bp - | BNodePs ab, BNodePs bb -> + | BnodPs ab, BnodPs bb -> bnodeps_equal ab bb | _, _ -> false @@ -256,7 +256,7 @@ module AST = struct Fmt.pf ppf "@[<h 1><triples@ subject %a@ predicate %a>@]" subject_pp s predobjs_pp p - | BNodePs b -> + | BnodPs b -> Fmt.pf ppf "@[<h 1><triples@ bnodeps %a>@]" bnodeps_pp b end @@ -331,14 +331,16 @@ end module Parser = struct open Angstrom + let whitespace_lst = ['\x20'; '\x0a'; '\x0d'; '\x09'; ] + let is_whitespace = function | '\x20' | '\x0a' | '\x0d' | '\x09' -> true | _ -> false let is_not_whitespace c = c |> is_whitespace |> not - let char_is_not_equal_to c d = - c != d + let char_is_not_equal_to lst d = + List.for_all (fun x -> x != d) lst let whitespace = many @@ choice [string " "; string "\n"; string "\t"] @@ -357,9 +359,9 @@ module Parser = struct let prefixed_name = lift2 AST.Prefixed_name.of_strings - (take_while (char_is_not_equal_to ':') + (take_while (char_is_not_equal_to ([':'] @ whitespace_lst)) <* char ':') - (take_while is_not_whitespace) + (take_while (char_is_not_equal_to ([']'] @ whitespace_lst))) let language = lift @@ -390,7 +392,7 @@ module Parser = struct (delimiters '"' '"') (option "" - (char '@' *> take_while (char_is_not_equal_to ':')) + (char '@' *> take_while ( char_is_not_equal_to ( [':'] @ whitespace_lst))) ) (option (AST.Iri.of_prefixed_name @@ AST.Prefixed_name.of_strings "xsd" "string") @@ -422,7 +424,7 @@ module Parser = struct ); (lift (fun literal -> - Fmt.pr "literal@."; + Fmt.pr "literal: %a@." AST.Literal.pp literal; AST.Obj_literal literal) literal ); @@ -474,7 +476,9 @@ module Parser = struct let bnodeps_ predobjs = lift - (fun predobjs -> AST.BNodePs predobjs) + (fun predobjs -> + Fmt.pr "BNODEPS"; + AST.BnodPs predobjs) ( char '[' *> whitespace @@ -500,7 +504,9 @@ module Parser = struct let object' = object_ collection bnodeps in sep_by1 semicolon ( lift2 - (fun p objs -> (p, objs)) + (fun p objs -> + Fmt.pr "PREDICATE %a @." AST.Predicate.pp p; + (p, objs)) (whitespace *> predicate <* whitespace) (sep_by1 comma (whitespace *> object' <* whitespace)) ) @@ -518,7 +524,7 @@ module Parser = struct subject predobjs); (lift - (fun bnodeps -> AST.Triples.BNodePs bnodeps) + (fun bnodeps -> AST.Triples.BnodPs bnodeps) bnodeps ) ] @@ -529,7 +535,7 @@ module Parser = struct (fun str iriref -> AST.Directive.PrefixID (str, iriref)) (string "@prefix" *> whitespace - *> (take_while (char_is_not_equal_to ':')) + *> (take_while (char_is_not_equal_to ([':'] @ whitespace_lst))) <* char ':' <* whitespace) (iriref diff --git a/lib/turtle/rdf_turtle.mli b/lib/turtle/rdf_turtle.mli index bf80de3..d1845fa 100644 --- a/lib/turtle/rdf_turtle.mli +++ b/lib/turtle/rdf_turtle.mli @@ -139,7 +139,7 @@ module AST : sig Sub_iri of Iri.t | Sub_blank_node of Blank_node.t | Sub_coll of collection - and bnodeps = BNodePs of predobjs + and bnodeps = BnodPs of predobjs and predobjs = (Predicate.t * object' list) list val object_equal : object' -> object' -> bool @@ -166,7 +166,7 @@ module AST : sig module Triples : sig type t = SubjPredObjs of subject * predobjs - | BNodePs of bnodeps + | BnodPs of bnodeps val equal : t -> t -> bool diff --git a/test/turtle/main.ml b/test/turtle/main.ml index fa75377..e299132 100644 --- a/test/turtle/main.ml +++ b/test/turtle/main.ml @@ -135,6 +135,10 @@ let object_test_case = "xsd:string", Iri.of_prefixed_name @@ Prefixed_name.of_strings "xsd" "string" |> (fun iri -> Obj_iri iri) ; + (* Iri *) + ":q", + Iri.of_prefixed_name @@ Prefixed_name.of_strings "" "q" + |> (fun iri -> Obj_iri iri) ; (* Blank_node *) "_:string", Obj_blank_node (Blank_node.of_string "string") ; @@ -159,7 +163,7 @@ let object_test_case = ) ; (* BNodePlist *) "[ foaf:name \"Bob\" ]", - Obj_BnodPs (BNodePs ([ Predicate.of_iri @@ Iri.of_prefixed_name @@ Prefixed_name.of_strings "foaf" "name", + Obj_BnodPs (BnodPs ([ Predicate.of_iri @@ Iri.of_prefixed_name @@ Prefixed_name.of_strings "foaf" "name", [ Obj_literal ( Literal.make ("Bob") (Iri.of_prefixed_name @@ Prefixed_name.of_strings "xsd" "string")) @@ -180,14 +184,19 @@ let object_test_case = let bnodeps_test_case = let cases = [ "[ foaf:name \"Bob\" ]", - BNodePs ([ Predicate.of_iri @@ Iri.of_prefixed_name @@ Prefixed_name.of_strings "foaf" "name", - [ Obj_literal ( Literal.make - ("Bob") - (Iri.of_prefixed_name @@ Prefixed_name.of_strings "xsd" "string")) - ] - ]) + BnodPs ([ Predicate.of_iri @@ Iri.of_prefixed_name @@ Prefixed_name.of_strings "foaf" "name", + [ Obj_literal ( Literal.make + ("Bob") + (Iri.of_prefixed_name @@ Prefixed_name.of_strings "xsd" "string")) + ] + ]) ; - ] in + "[:p :WWWW]", + BnodPs ([ Predicate.of_iri @@ Iri.of_prefixed_name @@ Prefixed_name.of_strings "" "p", + [ Obj_iri (Iri.of_prefixed_name @@ Prefixed_name.of_strings "" "WWWW"); ] ; ] + ); + ] + in test_case "bnodeps" `Quick (fun () -> List.iter @@ -200,6 +209,10 @@ let bnodeps_test_case = let predobjs_test_case = let cases = [ + ":p :WWWWWWWWWWWWWWWWWWWwwW", + [ Predicate.of_iri @@ Iri.of_prefixed_name @@ Prefixed_name.of_strings "" "p", + [ Obj_iri (Iri.of_prefixed_name @@ Prefixed_name.of_strings "" "WWWWWWWWWWWWWWWWWWWwwW"); ] ; ] + ; " foaf:name \"Bob\" ", [ Predicate.of_iri @@ Iri.of_prefixed_name @@ Prefixed_name.of_strings "foaf" "name", [ Obj_literal ( Literal.make @@ -226,7 +239,7 @@ let predobjs_test_case = (Iri.of_prefixed_name @@ Prefixed_name.of_strings "xsd" "string") ~language:"ru"); ] - ] + ] ; ] in test_case "predobjs" `Quick (fun () -> @@ -244,18 +257,29 @@ let subject_test_case = "<http://one.example/>", Sub_iri (Iri.of_iriref (Iriref.of_string "http://one.example/")); (* Collection *) - "(1 [:p :q] ( 2 ) )", + "(\"1\" [:p :q] ( \"2\" ) )", Sub_coll ( Collection ( [ Obj_literal ( Literal.make - ("apple") - (Iri.of_prefixed_name @@ Prefixed_name.of_strings "xsd" "string")) ; - Obj_literal ( - Literal.make - ("banana") + ("1") (Iri.of_prefixed_name @@ Prefixed_name.of_strings "xsd" "string")) ; + Obj_BnodPs ( + BnodPs ( + [ Predicate.of_iri @@ Iri.of_prefixed_name @@ Prefixed_name.of_strings "" "p", + [ Obj_iri (Iri.of_prefixed_name @@ Prefixed_name.of_strings "" "q"); ] ; ] + ) + ) ; + Obj_coll ( + Collection ( + [ Obj_literal ( + Literal.make + ("2") + (Iri.of_prefixed_name @@ Prefixed_name.of_strings "xsd" "string")) ; + ] + ) + ) ] ) ) ; |