From dc7d355dbc581c2595a2bba4c377cacb6c2ff696 Mon Sep 17 00:00:00 2001 From: Marcos Magueta Date: Sat, 31 Oct 2026 02:52:11 -0300 Subject: where modes drop only the attribute its index reads --- test/unit/evaluators/FOL.ml | 110 ++++++++++++++++++++++++++------------------ 1 file changed, 65 insertions(+), 45 deletions(-) (limited to 'test/unit/evaluators') diff --git a/test/unit/evaluators/FOL.ml b/test/unit/evaluators/FOL.ml index 2049f23..93eb8e7 100644 --- a/test/unit/evaluators/FOL.ml +++ b/test/unit/evaluators/FOL.ml @@ -208,47 +208,49 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = module F = Rnt.Evaluators.FOL - let restrict_through_an_index () = - let scanned = ref false and looked = ref [] in + let indexed ?(scanned = ref false) ?(looked = ref []) modes = let cursor tuples = Kernel.Generator.cursor_of (fun ~yield -> List.iter yield tuples; Ok ()) in let schema domain = {Protocols.Schematics.domain; provenance= []} in + Kernel.Prototype.mixture + Protocols. + [ Relation.make + object + method contains _ = Ok false + method modes = Ok modes + end; + Enumerable.make + object + method enumerate = + scanned := true; + Ok (cursor staff) + end; + Indexed.make + object + method indexes = ["age"] + + method lookup attribute value = + looked := attribute :: !looked; + Ok + (cursor + (List.filter + (fun tuple -> + BatMap.String.find_opt attribute tuple.Concepts.Tuple.attributes + |> Option.fold ~none:false ~some:(Concepts.Value.equal value) ) + staff ) ) + end; + Schematics.make + object + method describe () = + Ok + (Schematics.Relation + (BatMap.String.of_list ["name", schema "string"; "age", schema "integer"]) ) + end ] + + let restrict_through_an_index () = + let scanned = ref false and looked = ref [] in let relation = - Kernel.Prototype.mixture - Protocols. - [ Relation.make - object - method contains _ = Ok false - - method modes = - Ok Concepts.[Mode.mode [] Cardinality.Finite; Mode.mode ["age"] Cardinality.Finite] - end; - Enumerable.make - object - method enumerate = - scanned := true; - Ok (cursor staff) - end; - Indexed.make - object - method indexes = ["age"] - - method lookup attribute value = - looked := attribute :: !looked; - Ok - (cursor - (List.filter - (fun tuple -> - BatMap.String.find_opt attribute tuple.Concepts.Tuple.attributes - |> Option.fold ~none:false ~some:(Concepts.Value.equal value) ) - staff ) ) - end; - Schematics.make - object - method describe () = - Ok - (Schematics.Relation - (BatMap.String.of_list ["name", schema "string"; "age", schema "integer"]) ) - end ] + indexed ~scanned ~looked + Concepts.[Mode.mode [] Cardinality.Finite; Mode.mode ["age"] Cardinality.Finite] in let found = F.( @@ -268,6 +270,28 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = check bool "the relation was never scanned" false !scanned; check (list string) "its index was looked up once" ["age"] !looked + let a_restriction_ends_only_through_its_index () = + let ends modes binding = + F.execute (F.Where (F.Base (indexed modes), binding)) + |> Utilities.Result.( + fun result -> + result + |>> fun relation -> + Protocols.Handle.releasing relation (fun () -> + Result.bind (Protocols.Relation.require relation) Protocols.Relation.modes + |> Result.map (fun modes -> Concepts.Mode.exhaustible modes BatSet.String.empty) ) ) + |> Helpers.condition_as_failure + in + let endless = Concepts.Mode.mode [] Concepts.Cardinality.Countable in + let by attribute = Concepts.Mode.mode [attribute] Concepts.Cardinality.Finite in + check bool "a binding the index reads ends" true (ends [endless; by "age"] (aged 42)); + check bool "a binding no index reads does not" false + (ends [endless; by "age"] (called "Alaric")); + check bool "nor does one that would end only through an attribute without an index" false + (ends + [endless; by "name"] + (BatMap.String.add "name" (Concepts.Value.String "Alaric") (aged 42)) ) + let restrict_a_stored_relation conn = let run term f = begin @@ -301,13 +325,7 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = check bool "a tuple disagreeing with it is not" false (asking (F.Where (employees, aged 42)) - (fun r -> Protocols.Relation.contains r (employee "Brunhild" 30)) ); - check bool "through the index it ends with nothing bound" true - (asking - (F.Where (employees, aged 42)) - (fun r -> - Protocols.Relation.modes r - |> Result.map (fun modes -> Concepts.Mode.exhaustible modes BatSet.String.empty) ) ) + (fun r -> Protocols.Relation.contains r (employee "Brunhild" 30)) ) let restrict_inside_a_stored_program conn = let inner = F.Project (F.Where (employees, aged 42), BatFingerTree.singleton "name") in @@ -446,6 +464,8 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = test_case "a-projection-keeps-the-modes-it-can-bind" `Quick (H.with_connection a_projection_keeps_the_modes_it_can_bind "fol-test"); test_case "restrict-through-an-index" `Quick restrict_through_an_index; + test_case "a-restriction-ends-only-through-its-index" `Quick + a_restriction_ends_only_through_its_index; test_case "restrict-a-stored-relation" `Quick (H.with_connection restrict_a_stored_relation "fol-test"); test_case "restrict-inside-a-stored-program" `Quick -- cgit v1.2.3