update tests and add beam tests

1 files changed, 62 insertions, 1 deletions

diff --git a/test/unit/kernel/SubstantialRelation.ml b/test/unit/kernel/SubstantialRelation.ml
index 6000e52..b4e90dc 100644
--- a/test/unit/kernel/SubstantialRelation.ml
+++ b/test/unit/kernel/SubstantialRelation.ml
@@ -49,10 +49,71 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
            Concepts.Hash.hash_equals (Concepts.Tuple.hash tuple) (Concepts.Tuple.hash alaric) )
          enumerated )
 
+  let refuse_a_tuple_without_every_attribute conn =
+    let nameless = {alaric with attributes= BatMap.String.remove "name" alaric.attributes} in
+    check bool "storing it fails for the attribute it lacks" true
+      ( match H.relation conn ["name"; "age"] [nameless] with
+      | Error condition ->
+          BatString.starts_with (Concepts.Condition.to_string_hum condition) "missing-attribute"
+      | Ok _ -> false )
+
+  let employee name age =
+    { Concepts.Tuple.type_= "employee";
+      attributes=
+        BatMap.String.empty
+        |> BatMap.String.add "name" (Concepts.Value.String name)
+        |> BatMap.String.add "age" (Concepts.Value.Integer age) }
+
+  let look_up_by_one_attribute conn =
+    let names relation attribute value =
+      let open Utilities.Result in
+      let* indexed = Protocols.Indexed.require relation in
+      let* cursor = Protocols.Indexed.lookup indexed attribute value in
+      let* found = Protocols.Cursor.consuming cursor (fun scan -> Protocols.Cursor.drain scan ()) in
+      Ok
+        ( BatFingerTree.to_list found
+        |> List.map (fun tuple -> BatMap.String.find "name" tuple.Concepts.Tuple.attributes)
+        |> List.sort compare )
+    in
+    let indexes, aged, named, unaged, prefixed, unindexed =
+      begin
+        let open Utilities.Result in
+        let* relation =
+          H.relation conn ["name"; "age"]
+            [employee "Alaric" 42; employee "Brunhild" 30; employee "Gunther" 42]
+        in
+        let* indexed = Protocols.Indexed.require relation in
+        let* aged = names relation "age" (Concepts.Value.Integer 42) in
+        let* named = names relation "name" (Concepts.Value.String "Brunhild") in
+        let* unaged = names relation "age" (Concepts.Value.Integer 4) in
+        let* prefixed = names relation "name" (Concepts.Value.String "Al") in
+        let unindexed = names relation "salary" (Concepts.Value.Integer 1) in
+        Ok (Protocols.Indexed.indexes indexed, aged, named, unaged, prefixed, unindexed)
+      end
+      |> Helpers.condition_as_failure
+    in
+    let s v = Concepts.Value.String v in
+    check (list string) "every attribute is indexed" ["age"; "name"] indexes;
+    check (list Helpers.value) "an integer finds every tuple holding it"
+      [s "Alaric"; s "Gunther"]
+      aged;
+    check (list Helpers.value) "a string finds the tuple holding it" [s "Brunhild"] named;
+    check (list Helpers.value) "an integer is not a prefix of a longer one" [] unaged;
+    check (list Helpers.value) "a string is not a prefix of a longer one" [] prefixed;
+    check bool "an attribute without an index is refused" true
+      ( match unindexed with
+      | Error condition ->
+          BatString.starts_with (Concepts.Condition.to_string_hum condition) "unindexed-attribute"
+      | Ok _ -> false )
+
   let suite =
     ( "kernel/substantial-relation",
       [ test_case "contain-and-enumerate" `Quick
-          (H.with_connection contain_and_enumerate "substantial-relation-test") ] )
+          (H.with_connection contain_and_enumerate "substantial-relation-test");
+        test_case "refuse-a-tuple-without-every-attribute" `Quick
+          (H.with_connection refuse_a_tuple_without_every_attribute "substantial-relation-test");
+        test_case "look-up-by-one-attribute" `Quick
+          (H.with_connection look_up_by_one_attribute "substantial-relation-test") ] )
 end
 
 module LMDB = Make (Rnt.Backend.Storage.LMDB) (Helpers.Storage.LMDB_Configurator)