check tuples against the heading before storing

1 files changed, 13 insertions, 9 deletions

diff --git a/test/unit/kernel/SubstantialRelation.ml b/test/unit/kernel/SubstantialRelation.ml
index b4e90dc..20eb163 100644
--- a/test/unit/kernel/SubstantialRelation.ml
+++ b/test/unit/kernel/SubstantialRelation.ml
@@ -49,13 +49,17 @@ 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 refuse_a_tuple_off_its_heading conn =
+    let refused name attributes =
+      match H.relation conn ["name"; "age"] [{alaric with attributes}] with
+      | Error condition -> BatString.starts_with (Concepts.Condition.to_string_hum condition) name
+      | Ok _ -> false
+    in
+    check bool "a tuple lacking an attribute is refused" true
+      (refused "missing-attribute" (BatMap.String.remove "name" alaric.attributes));
+    check bool "a tuple with an attribute too many is refused" true
+      (refused "unexpected-attribute"
+         (BatMap.String.add "salary" (Concepts.Value.Integer 1) alaric.attributes) )
 
   let employee name age =
     { Concepts.Tuple.type_= "employee";
@@ -110,8 +114,8 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
     ( "kernel/substantial-relation",
       [ test_case "contain-and-enumerate" `Quick
           (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 "refuse-a-tuple-off-its-heading" `Quick
+          (H.with_connection refuse_a_tuple_off_its_heading "substantial-relation-test");
         test_case "look-up-by-one-attribute" `Quick
           (H.with_connection look_up_by_one_attribute "substantial-relation-test") ] )
 end