diff options
Diffstat (limited to '')
| -rw-r--r-- | test/Helpers.ml | 18 | ||||
| -rw-r--r-- | test/integration/Registration.ml | 8 | ||||
| -rw-r--r-- | test/test_rnt.ml | 1 | ||||
| -rw-r--r-- | test/unit/evaluators/FOL.ml | 119 | ||||
| -rw-r--r-- | test/unit/evaluators/Lambda.ml | 139 | ||||
| -rw-r--r-- | test/unit/kernel/EphemeralRelation.ml | 101 | ||||
| -rw-r--r-- | test/unit/kernel/Merkle.ml | 6 | ||||
| -rw-r--r-- | test/unit/kernel/SubstantialRelation.ml | 54 |
8 files changed, 178 insertions, 268 deletions
diff --git a/test/Helpers.ml b/test/Helpers.ml index 42cf8a5..7f65007 100644 --- a/test/Helpers.ml +++ b/test/Helpers.ml @@ -32,11 +32,29 @@ module Storage = struct module Make (S : Abstract.Storage.STORAGE) (C : CONFIGURATOR) = struct module SI = Kernel.Storage.Make (S) + module SR = Kernel.SubstantialRelation.Make (S) let store_schema tx attributes = Concepts.Encoding.Bencode.(Dict (List.map (fun a -> a, String "string") attributes) |> to_blob) |> SI.store_blob tx + let relation conn attributes tuples = + let open Utilities.Result in + let* value = + SI.with_transaction conn (fun tx -> + let* schematics = store_schema tx attributes in + let* _ = SR.TupleSet.empty_under tx in + let* node = + List.fold_left + (fun node tuple -> + let* node = node in + SR.TupleSet.insert tx (Concepts.Tuple.hash tuple) tuple node ) + (Ok SR.TupleSet.empty) tuples + in + Ok {SR.schematics; tuples= SR.TupleSet.hash_of node} ) + in + SR.load conn value + let with_connection f dir () = with_temporary_directory dir begin fun dir -> begin diff --git a/test/integration/Registration.ml b/test/integration/Registration.ml index 9ac26f4..60f1690 100644 --- a/test/integration/Registration.ml +++ b/test/integration/Registration.ml @@ -30,11 +30,11 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = end |> Helpers.condition_as_failure - let suite prefix = - ( "registration/" ^ prefix, - [test_case "registration tests" `Quick (H.with_connection run "registration-test")] ) + let suite = + ( "registration", + [test_case "register-and-lookup" `Quick (H.with_connection run "registration-test")] ) end module LMDB = Make (Rnt.Backend.Storage.LMDB) (Helpers.Storage.LMDB_Configurator) -let suites () = [LMDB.suite "lmdb"] +let suites () = [LMDB.suite] diff --git a/test/test_rnt.ml b/test/test_rnt.ml index b9c5962..799ad53 100644 --- a/test/test_rnt.ml +++ b/test/test_rnt.ml @@ -5,7 +5,6 @@ let all_suites = @ Unit.Kernel.Merkle.suites () @ Unit.Kernel.SubstantialRelation.suites () @ Unit.Evaluators.FOL.suites () - @ Unit.Evaluators.Lambda.suites () @ Integration.Registration.suites () let () = Alcotest.run "RNT" all_suites diff --git a/test/unit/evaluators/FOL.ml b/test/unit/evaluators/FOL.ml index 404e7a4..046fa3f 100644 --- a/test/unit/evaluators/FOL.ml +++ b/test/unit/evaluators/FOL.ml @@ -3,7 +3,6 @@ open Rnt module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = struct open Alcotest module H = Helpers.Storage.Make (S) (C) - module SR = Rnt.Kernel.SubstantialRelation.Make (S) let alaric = { Concepts.Tuple.type_= "employee"; @@ -14,20 +13,31 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = Concepts.Condition.condition "not-a-directory" "A handle was expected to carry the directory protocol and did not" Concepts.Condition.empty - let not_a_program () = - Concepts.Condition.condition "not-a-program" - "A handle was expected to carry the program protocol and did not" Concepts.Condition.empty + let missing name = + Concepts.Condition.condition "missing" "A name was expected in the directory and was absent" + Concepts.Condition.("name" |=| Concepts.Value.String name) + + let employee name age = + { Concepts.Tuple.type_= "employee"; + attributes= + BatMap.String.of_list ["name", Concepts.Value.String name; "age", Concepts.Value.Integer age] + } + + let drain result = + let open Utilities.Result in + let* enumerable = Protocols.Enumerable.require result in + let* cursor = Protocols.Enumerable.enumerate enumerable in + let* scan = Protocols.Cursor.require cursor in + let* tuples = Protocols.Cursor.drain scan () in + Protocols.Handle.release cursor; + Protocols.Handle.release result; + Ok (BatFingerTree.to_list tuples) let scan_a_base_relation conn = let scanned = begin let open Utilities.Result in - let* tx = S.start conn in - let* schematics = H.store_schema tx ["name"] in - let* relation = SR.empty tx ~schematics () in - let* relation = SR.assert_tuple tx relation alaric in - let* () = S.commit tx in - let* employee = SR.wrap conn relation in + let* employee = H.relation conn ["name"] [alaric] in let root = Kernel.Prototype.mixture [ Kernel.Prototype.Directory.of_properties @@ -37,17 +47,12 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = Protocols.Directory.from root |> Option.to_result ~none:(not_a_directory ()) in let* found = Protocols.Directory.find directory "fol" in - let* evaluator = Option.to_result ~none:(not_a_program ()) found in - let* interpreter = - Rnt.Evaluators.FOL.Program.from evaluator |> Option.to_result ~none:(not_a_program ()) + let* evaluator = Option.to_result ~none:(missing "fol") found in + let* evaluator = Protocols.Evaluator.require evaluator in + let* result = + Rnt.Evaluators.FOL.(program (Base employee)) |> Protocols.Evaluator.invoke evaluator in - let* cursor = - Rnt.Evaluators.FOL.Program.invoke interpreter (Rnt.Evaluators.FOL.Base employee) - in - let* scan = Protocols.Cursor.require cursor in - let* tuples = Protocols.Cursor.drain scan () in - Protocols.Handle.release cursor; - Ok (BatFingerTree.to_list tuples) + drain result end |> Helpers.condition_as_failure in @@ -58,12 +63,76 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = Concepts.Hash.hash_equals (Concepts.Tuple.hash tuple) (Concepts.Tuple.hash alaric) ) scanned ) - let suite prefix = - ( "fol/" ^ prefix, - [test_case "scan-a-base-relation" `Quick (H.with_connection scan_a_base_relation "fol-test")] - ) + let project_away_an_attribute conn = + let projected = + begin + let open Utilities.Result in + let* employees = + H.relation conn ["name"; "age"] + [employee "Alaric" 42; employee "Alaric" 30; employee "Brunhild" 42] + in + let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in + let* result = + Rnt.Evaluators.FOL.(program (Project (Base employees, BatFingerTree.singleton "name"))) + |> Protocols.Evaluator.invoke evaluator + in + drain result + end + |> Helpers.condition_as_failure + in + check + (list (list (pair string Helpers.value))) + "each name once, and nothing else" + [["name", Concepts.Value.String "Alaric"]; ["name", Concepts.Value.String "Brunhild"]] + ( projected + |> List.map (fun tuple -> BatMap.String.bindings tuple.Concepts.Tuple.attributes) + |> List.sort compare ) + + let pull_one_tuple_at_a_time () = + let produced = ref 0 and closed = ref false in + let description = + BatMap.String.singleton "value" {Protocols.Schematics.domain= "integer"; provenance= []} + in + let rec count ~yield n = + incr produced; + yield + { Concepts.Tuple.type_= "counter"; + attributes= BatMap.String.singleton "value" (Concepts.Value.Integer n) }; + count ~yield (n + 1) + in + let source = + Kernel.EphemeralRelation.instantiate description + {Kernel.EphemeralRelation.schematics= `Temporary description} + (fun () -> Ok (Kernel.Generator.cursor_of ~finally:(fun () -> closed := true) (count 0))) + in + let first = + begin + let open Utilities.Result in + let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in + let* result = + Rnt.Evaluators.FOL.(program (Project (Base source, BatFingerTree.singleton "value"))) + |> Protocols.Evaluator.invoke evaluator + in + let* enumerable = Protocols.Enumerable.require result in + let* cursor = Protocols.Enumerable.enumerate enumerable in + let* scan = Protocols.Cursor.require cursor in + let* first = Protocols.Cursor.next scan in + Protocols.Handle.release cursor; Protocols.Handle.release result; Ok first + end + |> Helpers.condition_as_failure + in + check bool "a tuple came through" true (Option.is_some first); + check int "the source produced only that tuple" 1 !produced; + check bool "and was closed with its consumer" true !closed + + let suite = + ( "evaluators/fol", + [ test_case "scan-a-base-relation" `Quick (H.with_connection scan_a_base_relation "fol-test"); + test_case "project-away-an-attribute" `Quick + (H.with_connection project_away_an_attribute "fol-test"); + test_case "pull-one-tuple-at-a-time" `Quick pull_one_tuple_at_a_time ] ) end module LMDB = Make (Rnt.Backend.Storage.LMDB) (Helpers.Storage.LMDB_Configurator) -let suites () = [LMDB.suite "lmdb"] +let suites () = [LMDB.suite] diff --git a/test/unit/evaluators/Lambda.ml b/test/unit/evaluators/Lambda.ml deleted file mode 100644 index ee15c16..0000000 --- a/test/unit/evaluators/Lambda.ml +++ /dev/null @@ -1,139 +0,0 @@ -open Rnt - -module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = struct - open Alcotest - module H = Helpers.Storage.Make (S) (C) - module SR = Rnt.Kernel.SubstantialRelation.Make (S) - - let datum = - { Concepts.Tuple.type_= "noun"; - attributes= BatMap.String.empty |> BatMap.String.add "lemma" (Concepts.Value.String "datum") - } - - let reticulare = - { Concepts.Tuple.type_= "verb"; - attributes= - BatMap.String.empty |> BatMap.String.add "lemma" (Concepts.Value.String "rēticulāre") } - - let not_a_directory () = - Concepts.Condition.condition "not-a-directory" - "A handle was expected to carry the directory protocol and did not" Concepts.Condition.empty - - let not_a_program () = - Concepts.Condition.condition "not-a-program" - "A handle was expected to carry the program protocol and did not" Concepts.Condition.empty - - (* Sets up the relations "noun" and "verb", each holding one Latin - lemma, hands [term] to the lambda evaluator, and drains the cursor - it returns. Change [term] in the cases below to play with the - calculus *) - let evaluate conn term = - let open Utilities.Result in - let* tx = S.start conn in - let* schematics = H.store_schema tx ["lemma"] in - let singleton tuple = - let* relation = SR.empty tx ~schematics () in - SR.assert_tuple tx relation tuple - in - let* noun = singleton datum in - let* verb = singleton reticulare in - let* () = S.commit tx in - let* noun = SR.wrap conn noun in - let* verb = SR.wrap conn verb in - let root = - Kernel.Prototype.mixture - [ Kernel.Prototype.Directory.of_properties - ["noun", noun; "verb", verb; "lambda", Rnt.Evaluators.Lambda.make ()] ] - in - let* directory = Protocols.Directory.from root |> Option.to_result ~none:(not_a_directory ()) in - let* found = Protocols.Directory.find directory "lambda" in - let* evaluator = Option.to_result ~none:(not_a_program ()) found in - let* interpreter = - Rnt.Evaluators.Lambda.Program.from evaluator |> Option.to_result ~none:(not_a_program ()) - in - let* cursor = Rnt.Evaluators.Lambda.(Program.invoke interpreter (Program (term, directory))) in - let* scan = Protocols.Cursor.require cursor in - let* tuples = Protocols.Cursor.drain scan () in - Protocols.Handle.release cursor; - Ok (BatFingerTree.to_list tuples) - - let is lemma tuple = - Concepts.Hash.hash_equals (Concepts.Tuple.hash tuple) (Concepts.Tuple.hash lemma) - - (* A bare name resolves through the directory, so the relations it - holds are the outer environment *) - let a_name_is_a_relation conn = - let scanned = - evaluate conn (Rnt.Evaluators.Lambda.Name "noun") |> Helpers.condition_as_failure - in - check int "one tuple scanned" 1 (List.length scanned); - check bool "the tuple that was asserted" true (List.for_all (is datum) scanned) - - (* (\x. x) noun *) - let identity_applied_to_a_relation conn = - let open Rnt.Evaluators.Lambda in - let scanned = - evaluate conn (Apply (Abstract ("x", Name "x"), Name "noun")) |> Helpers.condition_as_failure - in - check int "one tuple scanned" 1 (List.length scanned); - check bool "the tuple that was asserted" true (List.for_all (is datum) scanned) - - (* (\x. \y. x) noun (\z. z), so the argument that wins is the one - the closure kept *) - let a_closure_keeps_its_binding conn = - let open Rnt.Evaluators.Lambda in - let scanned = - evaluate conn - (Apply - (Apply (Abstract ("x", Abstract ("y", Name "x")), Name "noun"), Abstract ("z", Name "z")) - ) - |> Helpers.condition_as_failure - in - check int "one tuple scanned" 1 (List.length scanned); - check bool "the tuple that was asserted" true (List.for_all (is datum) scanned) - - (* The classic conditional, with no conditional in the calculus. A - boolean is the choice it makes, so [if] is application and both - branches are relations *) - let church_conditional conn = - let open Rnt.Evaluators.Lambda in - let true_ = Abstract ("then", Abstract ("else", Name "then")) in - let false_ = Abstract ("then", Abstract ("else", Name "else")) in - let if_ condition then_ else_ = Apply (Apply (condition, then_), else_) in - let declining = if_ true_ (Name "noun") (Name "verb") in - let conjugating = if_ false_ (Name "noun") (Name "verb") in - let declined = evaluate conn declining |> Helpers.condition_as_failure in - let conjugated = evaluate conn conjugating |> Helpers.condition_as_failure in - check int "one tuple on the then branch" 1 (List.length declined); - check bool "the then branch is the noun" true (List.for_all (is datum) declined); - check int "one tuple on the else branch" 1 (List.length conjugated); - check bool "the else branch is the verb" true (List.for_all (is reticulare) conjugated) - - (* A program reducing to an abstraction names nothing to - enumerate *) - let an_abstraction_is_not_a_result conn = - let open Rnt.Evaluators.Lambda in - match evaluate conn (Abstract ("x", Name "x")) with - | Error condition -> - check bool "unapplied abstraction" true - (String.starts_with ~prefix:"unapplied-abstraction" - (Concepts.Condition.to_string_hum condition) ) - | Ok _ -> fail "an abstraction was enumerated" - - let suite prefix = - ( "lambda/" ^ prefix, - [ test_case "a-name-is-a-relation" `Quick - (H.with_connection a_name_is_a_relation "lambda-name"); - test_case "identity-applied-to-a-relation" `Quick - (H.with_connection identity_applied_to_a_relation "lambda-identity"); - test_case "a-closure-keeps-its-binding" `Quick - (H.with_connection a_closure_keeps_its_binding "lambda-closure"); - test_case "church-conditional" `Quick - (H.with_connection church_conditional "lambda-conditional"); - test_case "an-abstraction-is-not-a-result" `Quick - (H.with_connection an_abstraction_is_not_a_result "lambda-abstraction") ] ) -end - -module LMDB = Make (Rnt.Backend.Storage.LMDB) (Helpers.Storage.LMDB_Configurator) - -let suites () = [LMDB.suite "lmdb"] diff --git a/test/unit/kernel/EphemeralRelation.ml b/test/unit/kernel/EphemeralRelation.ml index f75fd0d..c4bfc05 100644 --- a/test/unit/kernel/EphemeralRelation.ml +++ b/test/unit/kernel/EphemeralRelation.ml @@ -1,46 +1,21 @@ open Alcotest module Concepts = Rnt.Concepts module Protocols = Rnt.Protocols - -(* A derivation over a fixed set of members. It reads nothing and - computes nothing, so what the tests observe is the kernel object - rather than any particular evaluator. *) -module Derivation = struct - type plan = {name: string; members: Concepts.Tuple.t list; declared: Concepts.Mode.t} - - let identity {name; _} = Concepts.Hash.hash_of_bytes (Bytes.of_string name) - - let describe _ = - Ok - (BatMap.String.singleton "value" - { Protocols.Schematics.domain= "integer"; - provenance= [{Protocols.Schematics.source= ["example"]; attribute= "value"}] } ) - - let modes {declared; _} = Ok declared - - let generate {members; _} binding = - Ok - (Rnt.Kernel.Generator.cursor_of (fun ~yield -> - List.iter - (fun member -> if Protocols.Generative.satisfies binding member then yield member) - members; - Ok () ) ) -end - -module Derived = Rnt.Kernel.EphemeralRelation.Make (Derivation) +module Ephemeral = Rnt.Kernel.EphemeralRelation let member n = { Concepts.Tuple.type_= "example"; attributes= BatMap.String.singleton "value" (Concepts.Value.Integer n) } -let plan_over cardinality = - { Derivation.name= "the-derivation"; - members= [member 1; member 2; member 3]; - declared= - Concepts.Mode.of_list - [Concepts.Mode.enumerable cardinality; Concepts.Mode.decides_when ["value"]] } +let description = + BatMap.String.singleton "value" + { Protocols.Schematics.domain= "integer"; + provenance= [{Protocols.Schematics.source= ["example"]; attribute= "value"}] } -let derive plan = Derived.derive plan |> Helpers.condition_as_failure +let over ?inputs members = + Ephemeral.instantiate ?inputs description + {Ephemeral.schematics= `Temporary description} + (fun () -> Ok (Rnt.Kernel.Generator.cursor_of (fun ~yield -> List.iter yield members; Ok ()))) let values tuples = BatFingerTree.to_list tuples @@ -50,25 +25,11 @@ let values tuples = | _ -> None ) |> List.sort compare -let commit = Concepts.Hash.hash_of_bytes (Bytes.of_string "a-commit") - -let identity_is_the_derivation () = - let plan = plan_over Concepts.Cardinality.Finite in - check bool "unpinned, the identity of the plan" true - (Concepts.Hash.hash_equals (Derived.identity plan) (Derivation.identity plan)); - check bool "pinned to a commit, another identity" false - (Concepts.Hash.hash_equals (Derived.identity plan) (Derived.identity ~pinned:commit plan)); - check bool "the same pin twice is the same identity" true - (Concepts.Hash.hash_equals - (Derived.identity ~pinned:commit plan) - (Derived.identity ~pinned:commit plan) ) - -let an_exhaustible_derivation_enumerates () = - let derived = derive (plan_over Concepts.Cardinality.Finite) in +let enumerates_every_member () = let enumerated = begin let open Rnt.Utilities.Result in - let* enumerable = Protocols.Enumerable.require derived in + let* enumerable = Protocols.Enumerable.require (over [member 1; member 2; member 3]) in let* cursor = Protocols.Enumerable.enumerate enumerable in let* scan = Protocols.Cursor.require cursor in let* tuples = Protocols.Cursor.drain scan () in @@ -79,28 +40,25 @@ let an_exhaustible_derivation_enumerates () = in check (list int) "every member" [1; 2; 3] enumerated -let a_countable_derivation_decides_only () = - let derived = derive (plan_over Concepts.Cardinality.Countable) in +let decides_membership () = let holds, rejects = begin let open Rnt.Utilities.Result in - let* relation = Protocols.Relation.require derived in + let* relation = Protocols.Relation.require (over [member 1; member 2; member 3]) in let* holds = Protocols.Relation.contains relation (member 2) in let* rejects = Protocols.Relation.contains relation (member 9) in Ok (holds, rejects) end |> Helpers.condition_as_failure in - check bool "no enumeration is offered" false (Option.is_some (Protocols.Enumerable.from derived)); - check bool "membership is still decided" true holds; - check bool "and still refused" false rejects + check bool "a member is held" true holds; + check bool "a stranger is refused" false rejects -let a_derivation_describes_itself () = - let derived = derive (plan_over Concepts.Cardinality.Finite) in +let describes_itself () = let described = begin let open Rnt.Utilities.Result in - let* schematics = Protocols.Handle.require Protocols.Schematics.from derived in + let* schematics = Protocols.Handle.require Protocols.Schematics.from (over []) in Protocols.Schematics.describe schematics end |> Helpers.condition_as_failure @@ -118,32 +76,27 @@ let a_derivation_describes_itself () = String.concat "/" origin.Protocols.Schematics.source ^ "/" ^ origin.Protocols.Schematics.attribute ) ) ) - | _ -> fail "a derived relation describes itself as a relation" + | _ -> fail "an ephemeral relation describes itself as a relation" -let releasing_a_derivation_releases_its_inputs () = +let releasing_releases_its_inputs () = let released = ref false in let input = object method reference = true method release = released := true method hash = Concepts.Hash.hash_of_int 0 + method to_string = "input" method protocols : Protocols.Handle.protocol list = [] end in - let edge = Protocols.Handle.make input in - let derived = - Derived.derive ~edges:[edge] (plan_over Concepts.Cardinality.Finite) - |> Helpers.condition_as_failure - in - check bool "an input is held while the derivation lives" false !released; - Protocols.Handle.release derived; + let relation = over ~inputs:[Protocols.Handle.make input] [] in + check bool "an input is held while the relation lives" false !released; + Protocols.Handle.release relation; check bool "and released with it" true !released let suites () = [ ( "kernel/ephemeral-relation", - [ test_case "identity-is-the-derivation" `Quick identity_is_the_derivation; - test_case "an-exhaustible-derivation-enumerates" `Quick an_exhaustible_derivation_enumerates; - test_case "a-countable-derivation-decides-only" `Quick a_countable_derivation_decides_only; - test_case "a-derivation-describes-itself" `Quick a_derivation_describes_itself; - test_case "releasing-a-derivation-releases-its-inputs" `Quick - releasing_a_derivation_releases_its_inputs ] ) ] + [ test_case "enumerates-every-member" `Quick enumerates_every_member; + test_case "decides-membership" `Quick decides_membership; + test_case "describes-itself" `Quick describes_itself; + test_case "releasing-releases-its-inputs" `Quick releasing_releases_its_inputs ] ) ] diff --git a/test/unit/kernel/Merkle.ml b/test/unit/kernel/Merkle.ml index eaff92d..9d0dc6e 100644 --- a/test/unit/kernel/Merkle.ml +++ b/test/unit/kernel/Merkle.ml @@ -126,8 +126,8 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = (* let determinism _conn = *) (* () *) - let suite prefix = - ( "merkle/" ^ prefix, + let suite = + ( "kernel/merkle", [ test_case "insert-and-lookup" `Quick (H.with_connection insert_and_lookup "merkle-test"); test_case "batching" `Quick (H.with_connection batching "merkle-test"); test_case "persistence" `Quick (H.with_connection persistence "merkle-test"); @@ -136,4 +136,4 @@ end module LMDB = Make (Rnt.Backend.Storage.LMDB) (Helpers.Storage.LMDB_Configurator) -let suites () = [LMDB.suite "lmdb"] +let suites () = [LMDB.suite] diff --git a/test/unit/kernel/SubstantialRelation.ml b/test/unit/kernel/SubstantialRelation.ml index db13026..b9f87bf 100644 --- a/test/unit/kernel/SubstantialRelation.ml +++ b/test/unit/kernel/SubstantialRelation.ml @@ -5,8 +5,6 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = module H = Helpers.Storage.Make (S) (C) module SR = Rnt.Kernel.SubstantialRelation.Make (S) - let hash s = Concepts.Blob.blob_of_bytes (Bytes.of_string s) |> Concepts.Hash.hash_of_blob - let alaric = { Concepts.Tuple.type_= "employee"; attributes= @@ -14,26 +12,38 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = |> BatMap.String.add "name" (Concepts.Value.String "Alaric") |> BatMap.String.add "age" (Concepts.Value.Integer 42) } - let assert_and_enumerate conn = - let before, after, enumerated = + let contains relation tuple = + let open Utilities.Result in + let* relation = Protocols.Relation.require relation in + Protocols.Relation.contains relation tuple + + let enumerate relation = + let open Utilities.Result in + let* enumerable = Protocols.Enumerable.require relation in + let* cursor = Protocols.Enumerable.enumerate enumerable in + let* scan = Protocols.Cursor.require cursor in + let* enumerated = Protocols.Cursor.drain scan () in + Protocols.Handle.release cursor; + Ok (BatFingerTree.to_list enumerated) + + let contain_and_enumerate conn = + let absent, present, enumerated = begin let open Utilities.Result in - let* tx = S.start conn in - let* relation = SR.empty tx ~schematics:(hash "schema") () in - let* before = SR.contains_tuple tx relation alaric in - let* relation = SR.assert_tuple tx relation alaric in - let* after = SR.contains_tuple tx relation alaric in - let* () = S.commit tx in - let* cursor = SR.enumerate conn relation in - let* scan = Protocols.Cursor.require cursor in - let* enumerated = Protocols.Cursor.drain scan () in - Protocols.Handle.release cursor; - Ok (before, after, BatFingerTree.to_list enumerated) + let* schematics = + H.SI.with_transaction conn (fun tx -> H.store_schema tx ["name"; "age"]) + in + let* empty = SR.instantiate conn ~schematics in + let* absent = contains empty alaric in + let* holding = H.relation conn ["name"; "age"] [alaric] in + let* present = contains holding alaric in + let* enumerated = enumerate holding in + Ok (absent, present, enumerated) end |> Helpers.condition_as_failure in - check bool "absent before assertion" false before; - check bool "present after assertion" true after; + check bool "absent from an empty relation" false absent; + check bool "present in a relation holding it" true present; check int "one tuple enumerated" 1 (List.length enumerated); check bool "the tuple that was asserted" true (List.for_all @@ -41,12 +51,12 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = Concepts.Hash.hash_equals (Concepts.Tuple.hash tuple) (Concepts.Tuple.hash alaric) ) enumerated ) - let suite prefix = - ( "substantial-relation/" ^ prefix, - [ test_case "assert-and-enumerate" `Quick - (H.with_connection assert_and_enumerate "substantial-relation-test") ] ) + let suite = + ( "kernel/substantial-relation", + [ test_case "contain-and-enumerate" `Quick + (H.with_connection contain_and_enumerate "substantial-relation-test") ] ) end module LMDB = Make (Rnt.Backend.Storage.LMDB) (Helpers.Storage.LMDB_Configurator) -let suites () = [LMDB.suite "lmdb"] +let suites () = [LMDB.suite] |