aboutsummaryrefslogtreecommitdiff
path: root/test
diff options
context:
space:
mode:
authorpukkamustard <pukkamustard@posteo.net>2021-06-22 10:33:24 +0200
committerpukkamustard <pukkamustard@posteo.net>2021-06-22 10:46:54 +0200
commit67797a14aaf932c7ff6503d062447d8b59e4446e (patch)
treea294db5b091d638f9499583fa01834ab309f2d80 /test
parent9d992a8137b9a36be032dcecced141048507c7a2 (diff)
Rdf_fragment_graph: Reimplement using standard library Map and Set.
This gets rid of the containers dependency and cleans up implementaiton a bit.
Diffstat (limited to 'test')
-rw-r--r--test/fragment_graph/main.ml113
-rw-r--r--test/gen/rdf_gen.ml4
2 files changed, 83 insertions, 34 deletions
diff --git a/test/fragment_graph/main.ml b/test/fragment_graph/main.ml
index d7e0460..5a168a7 100644
--- a/test/fragment_graph/main.ml
+++ b/test/fragment_graph/main.ml
@@ -14,17 +14,15 @@ module FragmentGraph = Rdf_fragment_graph.Make(struct
module Gen = struct
let fragment_reference =
- QCheck.Gen.(string ~gen:(char_range 'a' 'z'))
-
+ QCheck.Gen.(string_size ~gen:(char_range 'a' 'z') small_nat)
+ |> QCheck.make
let predicate =
QCheck.choose
[
- QCheck.Gen.(
- fragment_reference
- >|= (fun id -> FragmentGraph.Predicate.FragmentReference id)
- )
- |> QCheck.make ;
+ fragment_reference
+ |> QCheck.map
+ FragmentGraph.Predicate.make_fragment_reference;
Rdf_gen.iri
|> QCheck.map FragmentGraph.Predicate.of_iri
@@ -33,11 +31,9 @@ module Gen = struct
let object' =
QCheck.choose
[
- QCheck.Gen.(
- fragment_reference
- >|= (fun id -> FragmentGraph.Object.FragmentReference id)
- )
- |> QCheck.make ;
+ fragment_reference
+ |> QCheck.map
+ FragmentGraph.Object.make_fragment_reference;
Rdf_gen.iri
|> QCheck.map FragmentGraph.Object.of_iri;
@@ -50,7 +46,17 @@ module Gen = struct
QCheck.pair predicate object'
let fragment_statement =
- QCheck.triple (QCheck.make fragment_reference) predicate object'
+ QCheck.triple fragment_reference predicate object'
+
+ let fragment_graph_add_statements statements fg =
+ List.fold_left (fun fg (p,o) -> FragmentGraph.add_statement p o fg)
+ fg
+ statements
+
+ let fragment_graph_add_fragment_statements fragment_statements fg =
+ List.fold_left (fun fg (f, p,o) -> FragmentGraph.add_fragment_statement f p o fg)
+ fg
+ fragment_statements
let fragment_graph =
QCheck.(
@@ -59,14 +65,12 @@ module Gen = struct
(list fragment_statement)
|> map
~rev:(fun fragment_graph ->
- (FragmentGraph.statements fragment_graph,
- FragmentGraph.fragment_statements fragment_graph))
+ (FragmentGraph.statements fragment_graph |> List.of_seq,
+ FragmentGraph.fragment_statements fragment_graph |> List.of_seq))
(fun (statements, fragment_statements) ->
- List.fold_left (fun fg (p, o) -> FragmentGraph.add_statement p o fg)
- (List.fold_left (fun fg (f, p, o) -> FragmentGraph.add_fragment_statement f p o fg)
- FragmentGraph.empty
- fragment_statements)
- statements
+ FragmentGraph.empty
+ |> fragment_graph_add_statements statements
+ |> fragment_graph_add_fragment_statements fragment_statements
)
)
end
@@ -74,7 +78,6 @@ end
let fragment_graph_testable =
Alcotest.testable FragmentGraph.pp FragmentGraph.equal
-
let ex = Rdf.Namespace.make_namespace "http://example.com/"
let equal_unit_test =
@@ -185,10 +188,64 @@ let equal_unit_test =
|> add_fragment_statement
"hi"
(Predicate.of_iri @@ ex "foo")
- (Object.of_iri @@ ex "bar2")))
+ (Object.of_iri @@ ex "bar2")));
+
+
+ check bool
+ "adding same literal twice results in equal fragment graph"
+ true
+ FragmentGraph.(equal
+ (empty
+ |> add_statement
+ (Predicate.of_iri @@ ex "prop")
+ (Object.of_literal @@ Rdf.Literal.make "hi" (ex "type")))
+ (empty
+ |> add_statement
+ (Predicate.of_iri @@ ex "prop")
+ (Object.of_literal @@ Rdf.Literal.make "hi" (ex "type"))
+ |> add_statement
+ (Predicate.of_iri @@ ex "prop")
+ (Object.of_literal @@ Rdf.Literal.make
+ (* do some transformations to make sure it is not physically equal *)
+ (String.lowercase_ascii (String.uppercase_ascii "hi"))
+ (ex "type"))))
)
+
+let shuffle lst =
+ let shuffle arr =
+ for n = Array.length arr - 1 downto 1 do
+ let k = Random.int (n + 1) in
+ let temp = arr.(n) in
+ arr.(n) <- arr.(k);
+ arr.(k) <- temp
+ done
+ in
+ let array = Array.of_list lst in
+ shuffle array;
+ Array.to_list array
+
+let equal_property_test =
+ QCheck.Test.make
+ ~name:"equality of fragment graphs when order of adding statements is shuffled"
+ (QCheck.pair
+ (QCheck.list Gen.statement)
+ (QCheck.list Gen.fragment_statement))
+ (fun (statements, fragment_statements) ->
+ let a =
+ FragmentGraph.empty
+ |> Gen.fragment_graph_add_statements statements
+ |> Gen.fragment_graph_add_fragment_statements fragment_statements
+ in
+ (* shuffle the order of insertions in b *)
+ let b =
+ FragmentGraph.empty
+ |> Gen.fragment_graph_add_statements (shuffle statements)
+ |> Gen.fragment_graph_add_fragment_statements (shuffle fragment_statements)
+ in
+ FragmentGraph.equal a b)
+
let canoncial_encode_decode_test =
QCheck.Test.make
~name:"encode/decode canonical serialization"
@@ -199,15 +256,6 @@ let canoncial_encode_decode_test =
|> FragmentGraph.of_canonical
|> Result.get_ok
) in
-
- if FragmentGraph.equal fragment_graph b then
- ()
- else
- Format.printf "NOT EQUAL: \n%a\n%a\n"
-
- FragmentGraph.pp fragment_graph
- FragmentGraph.pp b;
-
Alcotest.check fragment_graph_testable
"encoded/decoded value is same as original"
fragment_graph b ;
@@ -265,7 +313,8 @@ let canonical_unit_test =
let () =
Alcotest.run "rdf_fragment_graph" [
"equal", [
- equal_unit_test
+ equal_unit_test;
+ QCheck_alcotest.to_alcotest equal_property_test
];
"canonical serializaton", [
canonical_unit_test;
diff --git a/test/gen/rdf_gen.ml b/test/gen/rdf_gen.ml
index 741f0b0..c4d3c41 100644
--- a/test/gen/rdf_gen.ml
+++ b/test/gen/rdf_gen.ml
@@ -25,13 +25,13 @@ let iri =
let blank_node =
QCheck.Gen.(
Blank_node.of_string
- <$> oneofl ["a"])
+ <$> string_readable)
|> QCheck.make ~print:Blank_node.identifier
let literal =
QCheck.Gen.(
(fun s -> Literal.make s (Rdf.Namespace.xsd "string"))
- <$> oneofl ["b"]
+ <$> string_readable
)
|> QCheck.make ~print:Literal.canonical