update tests and add beam tests

2 files changed, 81 insertions, 2 deletions

diff --git a/test/unit/kernel/Branch.ml b/test/unit/kernel/Branch.ml
index a0f201d..10789cd 100644
--- a/test/unit/kernel/Branch.ml
+++ b/test/unit/kernel/Branch.ml
@@ -256,6 +256,23 @@ let a_denial_program_runs_once_per_judgement () =
        (K.Scope.publish root ~branch:"master" ~home:library ~denials:["dated", Some dated] []) );
   check int "and its program ran once to judge it" 1 !evaluations
 
+let a_denial_binds_an_attribute () =
+  let root = fresh ["Date"] in
+  let codd =
+    K.EphemeralRelation.of_program title
+      Rnt.Evaluators.FOL.(
+        program
+          (Where (Base (K.Scope.path library "book"), BatMap.String.singleton "title" (s "Codd"))) )
+  in
+  publish root ~denials:["no-codd", Some codd] [];
+  check bool "a book the rule binds is refused" true
+    (Result.is_error
+       (K.Scope.publish root ~branch:"master" ~home:library ["book", Some (books ["Date"; "Codd"])]) );
+  publish root ["book", Some (books ["Date"; "Darwen"])];
+  check (list Helpers.value) "any other book lands"
+    [s "Darwen"; s "Date"]
+    (read root (under master (K.Scope.path library "book")))
+
 let suites () =
   [ ( "kernel/branch",
       [ test_case "reads-as-of-each-state" `Quick reads_as_of_each_state;
@@ -271,4 +288,5 @@ let suites () =
         test_case "a-denial-without-end-cannot-be-installed" `Quick
           a_denial_without_end_cannot_be_installed;
         test_case "a-denial-program-runs-once-per-judgement" `Quick
-          a_denial_program_runs_once_per_judgement ] ) ]
+          a_denial_program_runs_once_per_judgement;
+        test_case "a-denial-binds-an-attribute" `Quick a_denial_binds_an_attribute ] ) ]
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)