diff options
Diffstat (limited to 'test/unit/kernel')
| -rw-r--r-- | test/unit/kernel/SubstantialRelation.ml | 22 |
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 |