diff options
Diffstat (limited to 'test')
| -rw-r--r-- | test/test_relational_engine.ml | 5942 |
1 files changed, 3461 insertions, 2481 deletions
diff --git a/test/test_relational_engine.ml b/test/test_relational_engine.ml index 619bc27..1d8f1ca 100644 --- a/test/test_relational_engine.ml +++ b/test/test_relational_engine.ml @@ -58,84 +58,78 @@ let%test_unit "merkle: root hash changes on insert" = assert (root1 <> root2) let%test_unit "merkle: same elements produce same root hash" = - let tree1 = Merkle.empty - |> Merkle.insert "a" - |> Merkle.insert "b" in - let tree2 = Merkle.empty - |> Merkle.insert "b" - |> Merkle.insert "a" in + let tree1 = Merkle.empty |> Merkle.insert "a" |> Merkle.insert "b" in + let tree2 = Merkle.empty |> Merkle.insert "b" |> Merkle.insert "a" in assert (Merkle.root_hash tree1 = Merkle.root_hash tree2) let%test_unit "storage: create and close" = match Management.Physical.Memory.create () with | Error _ -> assert false - | Ok storage -> - Management.Physical.Memory.close storage + | Ok storage -> Management.Physical.Memory.close storage let%test_unit "storage: store and load attribute" = match Management.Physical.Memory.create () with | Error _ -> assert false | Ok storage -> - let value = Obj.magic 42 in - (match Management.Physical.Memory.store_attribute storage value with - | Error _ -> assert false - | Ok hash -> - (match Management.Physical.Memory.load_attribute storage hash with - | Error _ -> assert false - | Ok None -> assert false - | Ok (Some loaded) -> - assert ((Obj.magic loaded : int) = 42))); - Management.Physical.Memory.close storage + let value = Obj.magic 42 in + (match Management.Physical.Memory.store_attribute storage value with + | Error _ -> assert false + | Ok hash -> ( + match Management.Physical.Memory.load_attribute storage hash with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some loaded) -> assert ((Obj.magic loaded : int) = 42))); + Management.Physical.Memory.close storage let%test_unit "storage: store and load raw bytes" = match Management.Physical.Memory.create () with | Error _ -> assert false | Ok storage -> - let hash = "test_hash" in - let data = Bytes.of_string "hello world" in - (match Management.Physical.Memory.store_raw storage hash data with - | Error _ -> assert false - | Ok () -> - (match Management.Physical.Memory.load_raw storage hash with - | Error _ -> assert false - | Ok None -> assert false - | Ok (Some loaded) -> - assert (Bytes.equal loaded data))); - Management.Physical.Memory.close storage + let hash = "test_hash" in + let data = Bytes.of_string "hello world" in + (match Management.Physical.Memory.store_raw storage hash data with + | Error _ -> assert false + | Ok () -> ( + match Management.Physical.Memory.load_raw storage hash with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some loaded) -> assert (Bytes.equal loaded data))); + Management.Physical.Memory.close storage let%test_unit "storage: exists check" = match Management.Physical.Memory.create () with | Error _ -> assert false | Ok storage -> - let hash = "exists_test" in - let data = Bytes.of_string "data" in - (match Management.Physical.Memory.exists storage hash with - | Error _ -> assert false - | Ok exists -> assert (not exists)); - (match Management.Physical.Memory.store_raw storage hash data with - | Error _ -> assert false - | Ok () -> - (match Management.Physical.Memory.exists storage hash with - | Error _ -> assert false - | Ok exists -> assert exists)); - Management.Physical.Memory.close storage + let hash = "exists_test" in + let data = Bytes.of_string "data" in + (match Management.Physical.Memory.exists storage hash with + | Error _ -> assert false + | Ok exists -> assert (not exists)); + (match Management.Physical.Memory.store_raw storage hash data with + | Error _ -> assert false + | Ok () -> ( + match Management.Physical.Memory.exists storage hash with + | Error _ -> assert false + | Ok exists -> assert exists)); + Management.Physical.Memory.close storage let%test_unit "storage: transaction commit" = match Management.Physical.Memory.create () with | Error _ -> assert false | Ok storage -> - let result = Management.Physical.Memory.with_transaction storage (fun () -> - let hash = "tx_test" in - let data = Bytes.of_string "tx_data" in - Management.Physical.Memory.store_raw storage hash data - ) in - (match result with - | Error _ -> assert false - | Ok () -> - (match Management.Physical.Memory.exists storage "tx_test" with - | Error _ -> assert false - | Ok exists -> assert exists)); - Management.Physical.Memory.close storage + let result = + Management.Physical.Memory.with_transaction storage (fun () -> + let hash = "tx_test" in + let data = Bytes.of_string "tx_data" in + Management.Physical.Memory.store_raw storage hash data) + in + (match result with + | Error _ -> assert false + | Ok () -> ( + match Management.Physical.Memory.exists storage "tx_test" with + | Error _ -> assert false + | Ok exists -> assert exists)); + Management.Physical.Memory.close storage let%test_unit "database: create empty" = let db = Management.Database.empty ~name:"test_db" in @@ -147,17 +141,13 @@ let%test_unit "database: create empty" = let%test_unit "database: add relation" = let db = Management.Database.empty ~name:"test_db" in (* Create a minimal relation for testing *) - let relation = Relation.make - ~hash:(Some "rel_hash_1") - ~name:"users" - ~schema:Schema.empty - ~tree:(Some Merkle.empty) - ~constraints:None - ~cardinality:(Conventions.Cardinality.Finite 0) - ~generator:None - ~membership_criteria:(fun _ -> true) - ~provenance:Relation.Provenance.Undefined - ~lineage:(Relation.Lineage.Base "users") + let relation = + Relation.make ~hash:(Some "rel_hash_1") ~name:"users" ~schema:Schema.empty + ~tree:(Some Merkle.empty) ~constraints:None + ~cardinality:(Conventions.Cardinality.Finite 0) ~generator:None + ~membership_criteria:(fun _ -> true) + ~provenance:Relation.Provenance.Undefined + ~lineage:(Relation.Lineage.Base "users") in let db = Management.Database.add_relation db ~relation in assert (Management.Database.has_relation db "users"); @@ -166,17 +156,13 @@ let%test_unit "database: add relation" = let%test_unit "database: remove relation" = let db = Management.Database.empty ~name:"test_db" in - let relation = Relation.make - ~hash:(Some "hash1") - ~name:"users" - ~schema:Schema.empty - ~tree:(Some Merkle.empty) - ~constraints:None - ~cardinality:(Conventions.Cardinality.Finite 0) - ~generator:None - ~membership_criteria:(fun _ -> true) - ~provenance:Relation.Provenance.Undefined - ~lineage:(Relation.Lineage.Base "users") + let relation = + Relation.make ~hash:(Some "hash1") ~name:"users" ~schema:Schema.empty + ~tree:(Some Merkle.empty) ~constraints:None + ~cardinality:(Conventions.Cardinality.Finite 0) ~generator:None + ~membership_criteria:(fun _ -> true) + ~provenance:Relation.Provenance.Undefined + ~lineage:(Relation.Lineage.Base "users") in let db = Management.Database.add_relation db ~relation in assert (Management.Database.has_relation db "users"); @@ -185,17 +171,13 @@ let%test_unit "database: remove relation" = let%test_unit "database: update relation" = let db = Management.Database.empty ~name:"test_db" in - let relation = Relation.make - ~hash:(Some "hash1") - ~name:"users" - ~schema:Schema.empty - ~tree:(Some Merkle.empty) - ~constraints:None - ~cardinality:(Conventions.Cardinality.Finite 0) - ~generator:None - ~membership_criteria:(fun _ -> true) - ~provenance:Relation.Provenance.Undefined - ~lineage:(Relation.Lineage.Base "users") + let relation = + Relation.make ~hash:(Some "hash1") ~name:"users" ~schema:Schema.empty + ~tree:(Some Merkle.empty) ~constraints:None + ~cardinality:(Conventions.Cardinality.Finite 0) ~generator:None + ~membership_criteria:(fun _ -> true) + ~provenance:Relation.Provenance.Undefined + ~lineage:(Relation.Lineage.Base "users") in let db = Management.Database.add_relation db ~relation in let old_db_hash = db.hash in @@ -207,29 +189,21 @@ let%test_unit "database: update relation" = let%test_unit "database: get relation names" = let db = Management.Database.empty ~name:"test_db" in - let rel1 = Relation.make - ~hash:(Some "h1") - ~name:"users" - ~schema:Schema.empty - ~tree:(Some Merkle.empty) - ~constraints:None - ~cardinality:(Conventions.Cardinality.Finite 0) - ~generator:None - ~membership_criteria:(fun _ -> true) - ~provenance:Relation.Provenance.Undefined - ~lineage:(Relation.Lineage.Base "users") - in - let rel2 = Relation.make - ~hash:(Some "h2") - ~name:"orders" - ~schema:Schema.empty - ~tree:(Some Merkle.empty) - ~constraints:None - ~cardinality:(Conventions.Cardinality.Finite 0) - ~generator:None - ~membership_criteria:(fun _ -> true) - ~provenance:Relation.Provenance.Undefined - ~lineage:(Relation.Lineage.Base "orders") + let rel1 = + Relation.make ~hash:(Some "h1") ~name:"users" ~schema:Schema.empty + ~tree:(Some Merkle.empty) ~constraints:None + ~cardinality:(Conventions.Cardinality.Finite 0) ~generator:None + ~membership_criteria:(fun _ -> true) + ~provenance:Relation.Provenance.Undefined + ~lineage:(Relation.Lineage.Base "users") + in + let rel2 = + Relation.make ~hash:(Some "h2") ~name:"orders" ~schema:Schema.empty + ~tree:(Some Merkle.empty) ~constraints:None + ~cardinality:(Conventions.Cardinality.Finite 0) ~generator:None + ~membership_criteria:(fun _ -> true) + ~provenance:Relation.Provenance.Undefined + ~lineage:(Relation.Lineage.Base "orders") in let db = Management.Database.add_relation db ~relation:rel1 in let db = Management.Database.add_relation db ~relation:rel2 in @@ -243,780 +217,1039 @@ let with_storage f = match Management.Physical.Memory.create () with | Error _ -> assert false | Ok storage -> - let result = f storage in - Management.Physical.Memory.close storage; - result + let result = f storage in + Management.Physical.Memory.close storage; + result let%test_unit "manipulation: create database" = with_storage (fun storage -> - match Manipulation.Memory.create_database storage ~name:"my_db" with - | Error _ -> assert false - | Ok db -> assert (db.name = "my_db")) + match Manipulation.Memory.create_database storage ~name:"my_db" with + | Error _ -> assert false + | Ok db -> assert (db.name = "my_db")) let%test_unit "manipulation: create relation" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty - |> Schema.add "name" "string" - |> Schema.add "age" "integer" in - match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with - | Error _ -> assert false - | Ok (db, relation) -> - assert (relation.name = "users"); - assert (relation.schema = schema); - assert (Management.Database.has_relation db "users")) + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db + in + let schema = + Schema.empty |> Schema.add "name" "string" |> Schema.add "age" "integer" + in + match + Manipulation.Memory.create_relation storage db ~name:"users" ~schema + with + | Error _ -> assert false + | Ok (db, relation) -> + assert (relation.name = "users"); + assert (relation.schema = schema); + assert (Management.Database.has_relation db "users")) let%test_unit "manipulation: create relation already exists" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty in - match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with - | Error _ -> assert false - | Ok (db, _) -> - match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with - | Error (Manipulation.RelationAlreadyExists _) -> () - | _ -> assert false) + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty in + match + Manipulation.Memory.create_relation storage db ~name:"users" ~schema + with + | Error _ -> assert false + | Ok (db, _) -> ( + match + Manipulation.Memory.create_relation storage db ~name:"users" ~schema + with + | Error (Manipulation.RelationAlreadyExists _) -> () + | _ -> assert false)) let%test_unit "manipulation: retract relation" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty in - match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with - | Error _ -> assert false - | Ok (db, _) -> - assert (Management.Database.has_relation db "users"); - match Manipulation.Memory.retract_relation storage db ~name:"users" with + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty in + match + Manipulation.Memory.create_relation storage db ~name:"users" ~schema + with | Error _ -> assert false - | Ok db -> - assert (not (Management.Database.has_relation db "users"))) + | Ok (db, _) -> ( + assert (Management.Database.has_relation db "users"); + match + Manipulation.Memory.retract_relation storage db ~name:"users" + with + | Error _ -> assert false + | Ok db -> assert (not (Management.Database.has_relation db "users")))) let%test_unit "manipulation: create tuple with storage" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty - |> Schema.add "name" "string" in - match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with - | Error _ -> assert false - | Ok (db, relation) -> - let attrs = Tuple.AttributeMap.empty - |> Tuple.AttributeMap.add "name" { Attribute.value = Obj.magic "Alice" } in - let tuple : Tuple.materialized = { relation = "users"; attributes = attrs } in - match Manipulation.Memory.create_tuple storage db relation tuple with + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty |> Schema.add "name" "string" in + match + Manipulation.Memory.create_relation storage db ~name:"users" ~schema + with | Error _ -> assert false - | Ok (_db, new_relation, _hash) -> - assert (Manipulation.Memory.tuple_count new_relation = 1)) + | Ok (db, relation) -> ( + let attrs = + Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "name" + { Attribute.value = Obj.magic "Alice" } + in + let tuple : Tuple.materialized = + { relation = "users"; attributes = attrs } + in + match Manipulation.Memory.create_tuple storage db relation tuple with + | Error _ -> assert false + | Ok (_db, new_relation, _hash) -> + assert (Manipulation.Memory.tuple_count new_relation = 1))) let%test_unit "manipulation: create and load tuple" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty - |> Schema.add "value" "integer" in - match Manipulation.Memory.create_relation storage db ~name:"numbers" ~schema with - | Error _ -> assert false - | Ok (db, relation) -> - let attrs = Tuple.AttributeMap.empty - |> Tuple.AttributeMap.add "value" { Attribute.value = Obj.magic 42 } in - let tuple : Tuple.materialized = { relation = "numbers"; attributes = attrs } in - match Manipulation.Memory.create_tuple storage db relation tuple with - | Error _ -> assert false - | Ok (_db, _relation, tuple_hash) -> - (* Now load the tuple back from storage *) - match Manipulation.Memory.load_tuple storage tuple_hash with + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with | Error _ -> assert false - | Ok None -> assert false - | Ok (Some loaded_tuple) -> - assert (loaded_tuple.relation = "numbers"); - let loaded_value = Tuple.AttributeMap.find "value" loaded_tuple.attributes in - assert ((Obj.magic loaded_value.Attribute.value : int) = 42)) + | Ok db -> db + in + let schema = Schema.empty |> Schema.add "value" "integer" in + match + Manipulation.Memory.create_relation storage db ~name:"numbers" ~schema + with + | Error _ -> assert false + | Ok (db, relation) -> ( + let attrs = + Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "value" { Attribute.value = Obj.magic 42 } + in + let tuple : Tuple.materialized = + { relation = "numbers"; attributes = attrs } + in + match Manipulation.Memory.create_tuple storage db relation tuple with + | Error _ -> assert false + | Ok (_db, _relation, tuple_hash) -> ( + (* Now load the tuple back from storage *) + match Manipulation.Memory.load_tuple storage tuple_hash with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some loaded_tuple) -> + assert (loaded_tuple.relation = "numbers"); + let loaded_value = + Tuple.AttributeMap.find "value" loaded_tuple.attributes + in + assert ((Obj.magic loaded_value.Attribute.value : int) = 42)))) let%test_unit "manipulation: create multiple tuples with storage" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty - |> Schema.add "id" "integer" in - match Manipulation.Memory.create_relation storage db ~name:"items" ~schema with - | Error _ -> assert false - | Ok (db, relation) -> - let make_tuple id = - let attrs = Tuple.AttributeMap.empty - |> Tuple.AttributeMap.add "id" { Attribute.value = Obj.magic id } in - ({ Tuple.relation = "items"; attributes = attrs } : Tuple.materialized) + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db in - let tuples = [make_tuple 1; make_tuple 2; make_tuple 3] in - match Manipulation.Memory.create_tuples storage db relation tuples with + let schema = Schema.empty |> Schema.add "id" "integer" in + match + Manipulation.Memory.create_relation storage db ~name:"items" ~schema + with | Error _ -> assert false - | Ok (_db, new_relation, hashes) -> - assert (Manipulation.Memory.tuple_count new_relation = 3); - assert (List.length hashes = 3)) + | Ok (db, relation) -> ( + let make_tuple id = + let attrs = + Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "id" { Attribute.value = Obj.magic id } + in + ({ Tuple.relation = "items"; attributes = attrs } + : Tuple.materialized) + in + let tuples = [ make_tuple 1; make_tuple 2; make_tuple 3 ] in + match + Manipulation.Memory.create_tuples storage db relation tuples + with + | Error _ -> assert false + | Ok (_db, new_relation, hashes) -> + assert (Manipulation.Memory.tuple_count new_relation = 3); + assert (List.length hashes = 3))) let%test_unit "manipulation: load multiple tuples" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty - |> Schema.add "n" "integer" in - match Manipulation.Memory.create_relation storage db ~name:"test" ~schema with - | Error _ -> assert false - | Ok (db, relation) -> - let make_tuple n = - let attrs = Tuple.AttributeMap.empty - |> Tuple.AttributeMap.add "n" { Attribute.value = Obj.magic n } in - ({ Tuple.relation = "test"; attributes = attrs } : Tuple.materialized) - in - match Manipulation.Memory.create_tuples storage db relation [make_tuple 10; make_tuple 20] with - | Error _ -> assert false - | Ok (_db, _relation, hashes) -> - match Manipulation.Memory.load_tuples storage hashes with - | Error _ -> assert false - | Ok loaded -> - assert (List.length loaded = 2); - let values = List.map (fun t -> - let attr = Tuple.AttributeMap.find "n" t.Tuple.attributes in - (Obj.magic attr.Attribute.value : int) - ) loaded in - assert (List.mem 10 values); - assert (List.mem 20 values)) + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty |> Schema.add "n" "integer" in + match + Manipulation.Memory.create_relation storage db ~name:"test" ~schema + with + | Error _ -> assert false + | Ok (db, relation) -> ( + let make_tuple n = + let attrs = + Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "n" { Attribute.value = Obj.magic n } + in + ({ Tuple.relation = "test"; attributes = attrs } + : Tuple.materialized) + in + match + Manipulation.Memory.create_tuples storage db relation + [ make_tuple 10; make_tuple 20 ] + with + | Error _ -> assert false + | Ok (_db, _relation, hashes) -> ( + match Manipulation.Memory.load_tuples storage hashes with + | Error _ -> assert false + | Ok loaded -> + assert (List.length loaded = 2); + let values = + List.map + (fun t -> + let attr = + Tuple.AttributeMap.find "n" t.Tuple.attributes + in + (Obj.magic attr.Attribute.value : int)) + loaded + in + assert (List.mem 10 values); + assert (List.mem 20 values)))) let%test_unit "manipulation: retract tuple" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty - |> Schema.add "value" "integer" in - match Manipulation.Memory.create_relation storage db ~name:"numbers" ~schema with - | Error _ -> assert false - | Ok (db, relation) -> - let attrs = Tuple.AttributeMap.empty - |> Tuple.AttributeMap.add "value" { Attribute.value = Obj.magic 42 } in - let tuple : Tuple.materialized = { relation = "numbers"; attributes = attrs } in - match Manipulation.Memory.create_tuple storage db relation tuple with - | Error _ -> assert false - | Ok (db, relation, tuple_hash) -> - assert (Manipulation.Memory.tuple_count relation = 1); - match Manipulation.Memory.retract_tuple storage db relation ~tuple_hash with - | Error _ -> assert false - | Ok (_db, relation) -> - assert (Manipulation.Memory.tuple_count relation = 0); - (* Tuple data still exists in storage (append-only) *) - match Manipulation.Memory.load_tuple storage tuple_hash with + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty |> Schema.add "value" "integer" in + match + Manipulation.Memory.create_relation storage db ~name:"numbers" ~schema + with + | Error _ -> assert false + | Ok (db, relation) -> ( + let attrs = + Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "value" { Attribute.value = Obj.magic 42 } + in + let tuple : Tuple.materialized = + { relation = "numbers"; attributes = attrs } + in + match Manipulation.Memory.create_tuple storage db relation tuple with | Error _ -> assert false - | Ok None -> assert false - | Ok (Some _) -> () (* Data is still there *)) + | Ok (db, relation, tuple_hash) -> ( + assert (Manipulation.Memory.tuple_count relation = 1); + match + Manipulation.Memory.retract_tuple storage db relation + ~tuple_hash + with + | Error _ -> assert false + | Ok (_db, relation) -> ( + assert (Manipulation.Memory.tuple_count relation = 0); + (* Tuple data still exists in storage (append-only) *) + match Manipulation.Memory.load_tuple storage tuple_hash with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some _) -> () (* Data is still there *))))) let%test_unit "manipulation: tuple hashes" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty in - match Manipulation.Memory.create_relation storage db ~name:"test" ~schema with - | Error _ -> assert false - | Ok (db, relation) -> - let make_tuple n = - let attrs = Tuple.AttributeMap.empty - |> Tuple.AttributeMap.add "n" { Attribute.value = Obj.magic n } in - ({ Tuple.relation = "test"; attributes = attrs } : Tuple.materialized) + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db in - match Manipulation.Memory.create_tuples storage db relation [make_tuple 1; make_tuple 2] with + let schema = Schema.empty in + match + Manipulation.Memory.create_relation storage db ~name:"test" ~schema + with | Error _ -> assert false - | Ok (_db, relation, _) -> - let hashes = Manipulation.Memory.tuple_hashes relation in - assert (List.length hashes = 2)) + | Ok (db, relation) -> ( + let make_tuple n = + let attrs = + Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "n" { Attribute.value = Obj.magic n } + in + ({ Tuple.relation = "test"; attributes = attrs } + : Tuple.materialized) + in + match + Manipulation.Memory.create_tuples storage db relation + [ make_tuple 1; make_tuple 2 ] + with + | Error _ -> assert false + | Ok (_db, relation, _) -> + let hashes = Manipulation.Memory.tuple_hashes relation in + assert (List.length hashes = 2))) let%test_unit "manipulation: clear relation" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty in - match Manipulation.Memory.create_relation storage db ~name:"test" ~schema with - | Error _ -> assert false - | Ok (db, relation) -> - let make_tuple n = - let attrs = Tuple.AttributeMap.empty - |> Tuple.AttributeMap.add "n" { Attribute.value = Obj.magic n } in - ({ Tuple.relation = "test"; attributes = attrs } : Tuple.materialized) + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db in - match Manipulation.Memory.create_tuples storage db relation [make_tuple 1; make_tuple 2; make_tuple 3] with + let schema = Schema.empty in + match + Manipulation.Memory.create_relation storage db ~name:"test" ~schema + with | Error _ -> assert false - | Ok (db, relation, _) -> - assert (Manipulation.Memory.tuple_count relation = 3); - match Manipulation.Memory.clear_relation storage db relation with - | Error _ -> assert false - | Ok (_db, relation) -> - assert (Manipulation.Memory.tuple_count relation = 0)) + | Ok (db, relation) -> ( + let make_tuple n = + let attrs = + Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "n" { Attribute.value = Obj.magic n } + in + ({ Tuple.relation = "test"; attributes = attrs } + : Tuple.materialized) + in + match + Manipulation.Memory.create_tuples storage db relation + [ make_tuple 1; make_tuple 2; make_tuple 3 ] + with + | Error _ -> assert false + | Ok (db, relation, _) -> ( + assert (Manipulation.Memory.tuple_count relation = 3); + match Manipulation.Memory.clear_relation storage db relation with + | Error _ -> assert false + | Ok (_db, relation) -> + assert (Manipulation.Memory.tuple_count relation = 0)))) let%test_unit "manipulation: duplicate tuple rejected" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty - |> Schema.add "x" "integer" in - match Manipulation.Memory.create_relation storage db ~name:"test" ~schema with - | Error _ -> assert false - | Ok (db, relation) -> - let attrs = Tuple.AttributeMap.empty - |> Tuple.AttributeMap.add "x" { Attribute.value = Obj.magic 1 } in - let tuple : Tuple.materialized = { relation = "test"; attributes = attrs } in - match Manipulation.Memory.create_tuple storage db relation tuple with - | Error _ -> assert false - | Ok (db, relation, _) -> - (* Try to insert the same tuple again *) - match Manipulation.Memory.create_tuple storage db relation tuple with - | Error (Manipulation.DuplicateTuple _) -> () - | _ -> assert false) + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty |> Schema.add "x" "integer" in + match + Manipulation.Memory.create_relation storage db ~name:"test" ~schema + with + | Error _ -> assert false + | Ok (db, relation) -> ( + let attrs = + Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "x" { Attribute.value = Obj.magic 1 } + in + let tuple : Tuple.materialized = + { relation = "test"; attributes = attrs } + in + match Manipulation.Memory.create_tuple storage db relation tuple with + | Error _ -> assert false + | Ok (db, relation, _) -> ( + (* Try to insert the same tuple again *) + match + Manipulation.Memory.create_tuple storage db relation tuple + with + | Error (Manipulation.DuplicateTuple _) -> () + | _ -> assert false))) let%test_unit "manipulation: tuple_exists check" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty in - match Manipulation.Memory.create_relation storage db ~name:"test" ~schema with - | Error _ -> assert false - | Ok (db, relation) -> - let attrs = Tuple.AttributeMap.empty - |> Tuple.AttributeMap.add "v" { Attribute.value = Obj.magic 99 } in - let tuple : Tuple.materialized = { relation = "test"; attributes = attrs } in - let tuple_hash = Manipulation.hash_tuple tuple in - assert (not (Manipulation.Memory.tuple_exists relation tuple_hash)); - match Manipulation.Memory.create_tuple storage db relation tuple with - | Error _ -> assert false - | Ok (_db, relation, hash) -> - assert (hash = tuple_hash); - assert (Manipulation.Memory.tuple_exists relation tuple_hash)) + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty in + match + Manipulation.Memory.create_relation storage db ~name:"test" ~schema + with + | Error _ -> assert false + | Ok (db, relation) -> ( + let attrs = + Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "v" { Attribute.value = Obj.magic 99 } + in + let tuple : Tuple.materialized = + { relation = "test"; attributes = attrs } + in + let tuple_hash = Manipulation.hash_tuple tuple in + assert (not (Manipulation.Memory.tuple_exists relation tuple_hash)); + match Manipulation.Memory.create_tuple storage db relation tuple with + | Error _ -> assert false + | Ok (_db, relation, hash) -> + assert (hash = tuple_hash); + assert (Manipulation.Memory.tuple_exists relation tuple_hash))) let%test_unit "manipulation: hash_tuple deterministic" = - let attrs = Tuple.AttributeMap.empty + let attrs = + Tuple.AttributeMap.empty |> Tuple.AttributeMap.add "a" { Attribute.value = Obj.magic 1 } - |> Tuple.AttributeMap.add "b" { Attribute.value = Obj.magic 2 } in + |> Tuple.AttributeMap.add "b" { Attribute.value = Obj.magic 2 } + in let tuple : Tuple.materialized = { relation = "test"; attributes = attrs } in let hash1 = Manipulation.hash_tuple tuple in let hash2 = Manipulation.hash_tuple tuple in assert (hash1 = hash2) let%test_unit "manipulation: different tuples different hashes" = - let tuple1 : Tuple.materialized = { - relation = "test"; - attributes = Tuple.AttributeMap.singleton "x" { Attribute.value = Obj.magic 1 } - } in - let tuple2 : Tuple.materialized = { - relation = "test"; - attributes = Tuple.AttributeMap.singleton "x" { Attribute.value = Obj.magic 2 } - } in + let tuple1 : Tuple.materialized = + { + relation = "test"; + attributes = + Tuple.AttributeMap.singleton "x" { Attribute.value = Obj.magic 1 }; + } + in + let tuple2 : Tuple.materialized = + { + relation = "test"; + attributes = + Tuple.AttributeMap.singleton "x" { Attribute.value = Obj.magic 2 }; + } + in let hash1 = Manipulation.hash_tuple tuple1 in let hash2 = Manipulation.hash_tuple tuple2 in assert (hash1 <> hash2) let%test_unit "manipulation: get_relation from database" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty - |> Schema.add "id" "integer" in - match Manipulation.Memory.create_relation storage db ~name:"items" ~schema with - | Error _ -> assert false - | Ok (db, _relation) -> - (* Now get the relation from the database *) - match Manipulation.Memory.get_relation db ~name:"items" with - | None -> assert false - | Some rel -> - assert (rel.name = "items"); - assert (rel.schema = schema)) + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty |> Schema.add "id" "integer" in + match + Manipulation.Memory.create_relation storage db ~name:"items" ~schema + with + | Error _ -> assert false + | Ok (db, _relation) -> ( + (* Now get the relation from the database *) + match Manipulation.Memory.get_relation db ~name:"items" with + | None -> assert false + | Some rel -> + assert (rel.name = "items"); + assert (rel.schema = schema))) let%test_unit "schema: persisted and loaded correctly" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty - |> Schema.add "id" "integer" - |> Schema.add "name" "string" - |> Schema.add "email" "string" in - match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with - | Error _ -> assert false - | Ok (db, _relation) -> - (* Get the relation hash *) - let rel_hash = Option.get (Management.Database.get_relation_hash db "users") in - (* Load the relation from storage *) - match Manipulation.Memory.load_relation storage rel_hash with + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db + in + let schema = + Schema.empty |> Schema.add "id" "integer" |> Schema.add "name" "string" + |> Schema.add "email" "string" + in + match + Manipulation.Memory.create_relation storage db ~name:"users" ~schema + with | Error _ -> assert false - | Ok None -> assert false - | Ok (Some loaded_rel) -> - (* Verify schema was persisted and loaded correctly *) - assert (loaded_rel.schema = schema); - assert (List.mem ("id", "integer") loaded_rel.schema); - assert (List.mem ("name", "string") loaded_rel.schema); - assert (List.mem ("email", "string") loaded_rel.schema)) + | Ok (db, _relation) -> ( + (* Get the relation hash *) + let rel_hash = + Option.get (Management.Database.get_relation_hash db "users") + in + (* Load the relation from storage *) + match Manipulation.Memory.load_relation storage rel_hash with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some loaded_rel) -> + (* Verify schema was persisted and loaded correctly *) + assert (loaded_rel.schema = schema); + assert (List.mem ("id", "integer") loaded_rel.schema); + assert (List.mem ("name", "string") loaded_rel.schema); + assert (List.mem ("email", "string") loaded_rel.schema))) let%test_unit "catalog: create_database seeds 6 catalog relations" = with_storage (fun storage -> - match Manipulation.Memory.create_database storage ~name:"test" with - | Error _ -> assert false - | Ok db -> - let catalog_names = Prelude.Catalog.catalog_relation_names in - List.iter (fun name -> - assert (Management.Database.has_relation db name) - ) catalog_names) + match Manipulation.Memory.create_database storage ~name:"test" with + | Error _ -> assert false + | Ok db -> + let catalog_names = Prelude.Catalog.catalog_relation_names in + List.iter + (fun name -> assert (Management.Database.has_relation db name)) + catalog_names) let%test_unit "catalog: sakura:relation contains all 6 catalog names" = with_storage (fun storage -> - match Manipulation.Memory.create_database storage ~name:"test" with - | Error _ -> assert false - | Ok db -> - let rel = match Manipulation.Memory.get_relation db ~name:"sakura:relation" with - | None -> assert false - | Some r -> r - in - assert (Manipulation.Memory.tuple_count rel = 6)) + match Manipulation.Memory.create_database storage ~name:"test" with + | Error _ -> assert false + | Ok db -> + let rel = + match + Manipulation.Memory.get_relation db ~name:"sakura:relation" + with + | None -> assert false + | Some r -> r + in + assert (Manipulation.Memory.tuple_count rel = 6)) let%test_unit "catalog: sakura:on contains insert, update, delete" = with_storage (fun storage -> - match Manipulation.Memory.create_database storage ~name:"test" with - | Error _ -> assert false - | Ok db -> - let on_rel = match Manipulation.Memory.get_relation db ~name:"sakura:on" with - | None -> assert false - | Some r -> r - in - assert (Manipulation.Memory.tuple_count on_rel = 3)) + match Manipulation.Memory.create_database storage ~name:"test" with + | Error _ -> assert false + | Ok db -> + let on_rel = + match Manipulation.Memory.get_relation db ~name:"sakura:on" with + | None -> assert false + | Some r -> r + in + assert (Manipulation.Memory.tuple_count on_rel = 3)) let%test_unit "catalog: sakura:timing contains immediate, deferred" = with_storage (fun storage -> - match Manipulation.Memory.create_database storage ~name:"test" with - | Error _ -> assert false - | Ok db -> - let timing_rel = match Manipulation.Memory.get_relation db ~name:"sakura:timing" with - | None -> assert false - | Some r -> r - in - assert (Manipulation.Memory.tuple_count timing_rel = 2)) + match Manipulation.Memory.create_database storage ~name:"test" with + | Error _ -> assert false + | Ok db -> + let timing_rel = + match Manipulation.Memory.get_relation db ~name:"sakura:timing" with + | None -> assert false + | Some r -> r + in + assert (Manipulation.Memory.tuple_count timing_rel = 2)) let%test_unit "catalog: sakura:domain seeded with 4 prelude domains" = with_storage (fun storage -> - match Manipulation.Memory.create_database storage ~name:"test" with - | Error _ -> assert false - | Ok db -> - let dom_rel = match Manipulation.Memory.get_relation db ~name:"sakura:domain" with - | None -> assert false - | Some r -> r - in - assert (Manipulation.Memory.tuple_count dom_rel = 4)) + match Manipulation.Memory.create_database storage ~name:"test" with + | Error _ -> assert false + | Ok db -> + let dom_rel = + match Manipulation.Memory.get_relation db ~name:"sakura:domain" with + | None -> assert false + | Some r -> r + in + assert (Manipulation.Memory.tuple_count dom_rel = 4)) let%test_unit "catalog: create_relation updates sakura:relation" = with_storage (fun storage -> - match Manipulation.Memory.create_database storage ~name:"test" with - | Error _ -> assert false - | Ok db -> - let schema = Schema.empty |> Schema.add "id" "natural" in - let db = match Manipulation.Memory.create_relation storage db ~name:"employees" ~schema with - | Error _ -> assert false | Ok (db, _) -> db - in - let rel = match Manipulation.Memory.get_relation db ~name:"sakura:relation" with - | None -> assert false | Some r -> r - in - (* 6 catalog relations + 1 user relation *) - assert (Manipulation.Memory.tuple_count rel = 7)) + match Manipulation.Memory.create_database storage ~name:"test" with + | Error _ -> assert false + | Ok db -> + let schema = Schema.empty |> Schema.add "id" "natural" in + let db = + match + Manipulation.Memory.create_relation storage db ~name:"employees" + ~schema + with + | Error _ -> assert false + | Ok (db, _) -> db + in + let rel = + match + Manipulation.Memory.get_relation db ~name:"sakura:relation" + with + | None -> assert false + | Some r -> r + in + (* 6 catalog relations + 1 user relation *) + assert (Manipulation.Memory.tuple_count rel = 7)) let%test_unit "catalog: create_relation updates sakura:attribute" = with_storage (fun storage -> - match Manipulation.Memory.create_database storage ~name:"test" with - | Error _ -> assert false - | Ok db -> - let schema = Schema.empty |> Schema.add "id" "natural" in - let db = match Manipulation.Memory.create_relation storage db ~name:"employees" ~schema with - | Error _ -> assert false | Ok (db, _) -> db - in - let attr_rel = match Manipulation.Memory.get_relation db ~name:"sakura:attribute" with - | None -> assert false | Some r -> r - in - (* catalog attribute tuples (sum of schema sizes of all 6 catalog relations) + 1 for employees *) - (* sakura:relation: 1, sakura:domain: 1, sakura:attribute: 3, sakura:constraint: 2, + match Manipulation.Memory.create_database storage ~name:"test" with + | Error _ -> assert false + | Ok db -> + let schema = Schema.empty |> Schema.add "id" "natural" in + let db = + match + Manipulation.Memory.create_relation storage db ~name:"employees" + ~schema + with + | Error _ -> assert false + | Ok (db, _) -> db + in + let attr_rel = + match + Manipulation.Memory.get_relation db ~name:"sakura:attribute" + with + | None -> assert false + | Some r -> r + in + (* catalog attribute tuples (sum of schema sizes of all 6 catalog relations) + 1 for employees *) + (* sakura:relation: 1, sakura:domain: 1, sakura:attribute: 3, sakura:constraint: 2, sakura:on: 1, sakura:timing: 1 => 9 catalog attrs + 1 for employees = 10 *) - let count = Manipulation.Memory.tuple_count attr_rel in - assert (count = 10)) + let count = Manipulation.Memory.tuple_count attr_rel in + assert (count = 10)) let%test_unit "catalog: retract_relation removes from sakura:relation" = with_storage (fun storage -> - match Manipulation.Memory.create_database storage ~name:"test" with - | Error _ -> assert false - | Ok db -> - let schema = Schema.empty |> Schema.add "id" "natural" in - let db = match Manipulation.Memory.create_relation storage db ~name:"employees" ~schema with - | Error _ -> assert false | Ok (db, _) -> db - in - let db = match Manipulation.Memory.retract_relation storage db ~name:"employees" with - | Error _ -> assert false | Ok db -> db - in - let rel = match Manipulation.Memory.get_relation db ~name:"sakura:relation" with - | None -> assert false | Some r -> r - in - (* Back to 6 catalog relations *) - assert (Manipulation.Memory.tuple_count rel = 6)) + match Manipulation.Memory.create_database storage ~name:"test" with + | Error _ -> assert false + | Ok db -> + let schema = Schema.empty |> Schema.add "id" "natural" in + let db = + match + Manipulation.Memory.create_relation storage db ~name:"employees" + ~schema + with + | Error _ -> assert false + | Ok (db, _) -> db + in + let db = + match + Manipulation.Memory.retract_relation storage db ~name:"employees" + with + | Error _ -> assert false + | Ok db -> db + in + let rel = + match + Manipulation.Memory.get_relation db ~name:"sakura:relation" + with + | None -> assert false + | Some r -> r + in + (* Back to 6 catalog relations *) + assert (Manipulation.Memory.tuple_count rel = 6)) let%test_unit "catalog: register_constraint inserts into sakura:constraint" = with_storage (fun storage -> - match Manipulation.Memory.create_database storage ~name:"test" with - | Error _ -> assert false - | Ok db -> - let schema = Schema.empty |> Schema.add "id" "natural" in - let db = match Manipulation.Memory.create_relation storage db ~name:"orders" ~schema with - | Error _ -> assert false | Ok (db, _) -> db - in - let db = match Manipulation.Memory.register_constraint storage db - ~constraint_name:"orders_id_positive" - ~relation_name:"orders" - ~body:(Constraint.And []) with - | Error _ -> assert false | Ok db -> db - in - let con_rel = match Manipulation.Memory.get_relation db ~name:"sakura:constraint" with - | None -> assert false | Some r -> r - in - assert (Manipulation.Memory.tuple_count con_rel = 1)) + match Manipulation.Memory.create_database storage ~name:"test" with + | Error _ -> assert false + | Ok db -> + let schema = Schema.empty |> Schema.add "id" "natural" in + let db = + match + Manipulation.Memory.create_relation storage db ~name:"orders" + ~schema + with + | Error _ -> assert false + | Ok (db, _) -> db + in + let db = + match + Manipulation.Memory.register_constraint storage db + ~constraint_name:"orders_id_positive" ~relation_name:"orders" + ~body:(Constraint.And []) + with + | Error _ -> assert false + | Ok db -> db + in + let con_rel = + match + Manipulation.Memory.get_relation db ~name:"sakura:constraint" + with + | None -> assert false + | Some r -> r + in + assert (Manipulation.Memory.tuple_count con_rel = 1)) let%test_unit "integration: full workflow with storage" = with_storage (fun storage -> - (* Create database *) - let db = match Manipulation.Memory.create_database storage ~name:"shop" with - | Error _ -> assert false | Ok db -> db - in - - (* Create products relation *) - let schema = Schema.empty - |> Schema.add "id" "integer" - |> Schema.add "name" "string" - |> Schema.add "price" "integer" in + (* Create database *) + let db = + match Manipulation.Memory.create_database storage ~name:"shop" with + | Error _ -> assert false + | Ok db -> db + in - let (db, products) = match Manipulation.Memory.create_relation storage db ~name:"products" ~schema with - | Error _ -> assert false - | Ok x -> x - in + (* Create products relation *) + let schema = + Schema.empty |> Schema.add "id" "integer" |> Schema.add "name" "string" + |> Schema.add "price" "integer" + in - (* Insert some products *) - let make_product id name price = - let attrs = Tuple.AttributeMap.empty - |> Tuple.AttributeMap.add "id" { Attribute.value = Obj.magic id } - |> Tuple.AttributeMap.add "name" { Attribute.value = Obj.magic name } - |> Tuple.AttributeMap.add "price" { Attribute.value = Obj.magic price } in - ({ Tuple.relation = "products"; attributes = attrs } : Tuple.materialized) - in + let db, products = + match + Manipulation.Memory.create_relation storage db ~name:"products" + ~schema + with + | Error _ -> assert false + | Ok x -> x + in - let tuples = [ - make_product 1 "Apple" 100; - make_product 2 "Banana" 50; - make_product 3 "Cherry" 200; - ] in + (* Insert some products *) + let make_product id name price = + let attrs = + Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "id" { Attribute.value = Obj.magic id } + |> Tuple.AttributeMap.add "name" { Attribute.value = Obj.magic name } + |> Tuple.AttributeMap.add "price" + { Attribute.value = Obj.magic price } + in + ({ Tuple.relation = "products"; attributes = attrs } + : Tuple.materialized) + in - let (db, products, hashes) = match Manipulation.Memory.create_tuples storage db products tuples with - | Error _ -> assert false - | Ok x -> x - in + let tuples = + [ + make_product 1 "Apple" 100; + make_product 2 "Banana" 50; + make_product 3 "Cherry" 200; + ] + in - assert (Manipulation.Memory.tuple_count products = 3); - assert (List.length hashes = 3); + let db, products, hashes = + match Manipulation.Memory.create_tuples storage db products tuples with + | Error _ -> assert false + | Ok x -> x + in - (* Verify we can load all tuples back *) - (match Manipulation.Memory.load_tuples storage hashes with - | Error _ -> assert false - | Ok loaded -> assert (List.length loaded = 3)); + assert (Manipulation.Memory.tuple_count products = 3); + assert (List.length hashes = 3); - (* Delete one product *) - let banana_hash = Manipulation.hash_tuple (make_product 2 "Banana" 50) in - let (_db, products) = match Manipulation.Memory.retract_tuple storage db products ~tuple_hash:banana_hash with + (* Verify we can load all tuples back *) + (match Manipulation.Memory.load_tuples storage hashes with | Error _ -> assert false - | Ok x -> x - in + | Ok loaded -> assert (List.length loaded = 3)); + + (* Delete one product *) + let banana_hash = Manipulation.hash_tuple (make_product 2 "Banana" 50) in + let _db, products = + match + Manipulation.Memory.retract_tuple storage db products + ~tuple_hash:banana_hash + with + | Error _ -> assert false + | Ok x -> x + in - assert (Manipulation.Memory.tuple_count products = 2); + assert (Manipulation.Memory.tuple_count products = 2); - (* Verify remaining hashes *) - let remaining_hashes = Manipulation.Memory.tuple_hashes products in - assert (List.length remaining_hashes = 2); - assert (not (List.mem banana_hash remaining_hashes)); + (* Verify remaining hashes *) + let remaining_hashes = Manipulation.Memory.tuple_hashes products in + assert (List.length remaining_hashes = 2); + assert (not (List.mem banana_hash remaining_hashes)); - (* But banana data is still in storage (append-only) *) - match Manipulation.Memory.load_tuple storage banana_hash with - | Error _ -> assert false - | Ok None -> assert false - | Ok (Some loaded) -> - let name_attr = Tuple.AttributeMap.find "name" loaded.attributes in - assert ((Obj.magic name_attr.Attribute.value : string) = "Banana")) + (* But banana data is still in storage (append-only) *) + match Manipulation.Memory.load_tuple storage banana_hash with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some loaded) -> + let name_attr = Tuple.AttributeMap.find "name" loaded.attributes in + assert ((Obj.magic name_attr.Attribute.value : string) = "Banana")) let%test_unit "integration: database history tracking" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"versioned" with - | Error _ -> assert false | Ok db -> db - in - let initial_hash = db.hash in + let db = + match Manipulation.Memory.create_database storage ~name:"versioned" with + | Error _ -> assert false + | Ok db -> db + in + let initial_hash = db.hash in - let schema = Schema.empty in - let (db, _) = match Manipulation.Memory.create_relation storage db ~name:"rel1" ~schema with - | Error _ -> assert false - | Ok x -> x - in + let schema = Schema.empty in + let db, _ = + match + Manipulation.Memory.create_relation storage db ~name:"rel1" ~schema + with + | Error _ -> assert false + | Ok x -> x + in - (* After first change, initial hash should be in history *) - assert (db.hash <> initial_hash); + (* After first change, initial hash should be in history *) + assert (db.hash <> initial_hash); - let hash_after_rel1 = db.hash in + let hash_after_rel1 = db.hash in - let (db, _) = match Manipulation.Memory.create_relation storage db ~name:"rel2" ~schema with - | Error _ -> assert false - | Ok x -> x - in + let db, _ = + match + Manipulation.Memory.create_relation storage db ~name:"rel2" ~schema + with + | Error _ -> assert false + | Ok x -> x + in - (* After second change, previous hash should be in history *) - assert (db.hash <> hash_after_rel1); - assert (List.mem hash_after_rel1 db.history)) + (* After second change, previous hash should be in history *) + assert (db.hash <> hash_after_rel1); + assert (List.mem hash_after_rel1 db.history)) let%test_unit "integration: hash bubbles up correctly" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty in + let db = + match Manipulation.Memory.create_database storage ~name:"test" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty in - let (db, relation) = match Manipulation.Memory.create_relation storage db ~name:"items" ~schema with - | Error _ -> assert false - | Ok x -> x - in + let db, relation = + match + Manipulation.Memory.create_relation storage db ~name:"items" ~schema + with + | Error _ -> assert false + | Ok x -> x + in - let db_hash_before = db.hash in - let rel_hash_before = relation.hash in + let db_hash_before = db.hash in + let rel_hash_before = relation.hash in - (* Insert a tuple *) - let attrs = Tuple.AttributeMap.empty - |> Tuple.AttributeMap.add "x" { Attribute.value = Obj.magic 1 } in - let tuple : Tuple.materialized = { relation = "items"; attributes = attrs } in + (* Insert a tuple *) + let attrs = + Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "x" { Attribute.value = Obj.magic 1 } + in + let tuple : Tuple.materialized = + { relation = "items"; attributes = attrs } + in - let (db, relation, _) = match Manipulation.Memory.create_tuple storage db relation tuple with - | Error _ -> assert false - | Ok x -> x - in + let db, relation, _ = + match Manipulation.Memory.create_tuple storage db relation tuple with + | Error _ -> assert false + | Ok x -> x + in - (* Relation hash should change *) - assert (relation.hash <> rel_hash_before); + (* Relation hash should change *) + assert (relation.hash <> rel_hash_before); - (* Database hash should change *) - assert (db.hash <> db_hash_before); + (* Database hash should change *) + assert (db.hash <> db_hash_before); - (* Old database hash should be in history *) - assert (List.mem db_hash_before db.history); + (* Old database hash should be in history *) + assert (List.mem db_hash_before db.history); - (* Database's merkle tree should contain the new relation hash *) - match relation.hash with - | None -> assert false - | Some rel_hash -> - assert (Merkle.member rel_hash db.tree)) + (* Database's merkle tree should contain the new relation hash *) + match relation.hash with + | None -> assert false + | Some rel_hash -> assert (Merkle.member rel_hash db.tree)) let%test_unit "branching: load database from historical hash" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty in + let db = + match Manipulation.Memory.create_database storage ~name:"test" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty in - (* Create relation and add a tuple *) - let (db, relation) = match Manipulation.Memory.create_relation storage db ~name:"items" ~schema with - | Error _ -> assert false - | Ok x -> x - in + (* Create relation and add a tuple *) + let db, relation = + match + Manipulation.Memory.create_relation storage db ~name:"items" ~schema + with + | Error _ -> assert false + | Ok x -> x + in - let attrs = Tuple.AttributeMap.empty - |> Tuple.AttributeMap.add "x" { Attribute.value = Obj.magic 1 } in - let tuple : Tuple.materialized = { relation = "items"; attributes = attrs } in + let attrs = + Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "x" { Attribute.value = Obj.magic 1 } + in + let tuple : Tuple.materialized = + { relation = "items"; attributes = attrs } + in - let (db, _relation, _) = match Manipulation.Memory.create_tuple storage db relation tuple with - | Error _ -> assert false - | Ok x -> x - in + let db, _relation, _ = + match Manipulation.Memory.create_tuple storage db relation tuple with + | Error _ -> assert false + | Ok x -> x + in - (* Capture hash H1 - database with 1 tuple *) - let h1 = db.hash in + (* Capture hash H1 - database with 1 tuple *) + let h1 = db.hash in - (* Add another tuple *) - let attrs2 = Tuple.AttributeMap.empty - |> Tuple.AttributeMap.add "x" { Attribute.value = Obj.magic 2 } in - let tuple2 : Tuple.materialized = { relation = "items"; attributes = attrs2 } in + (* Add another tuple *) + let attrs2 = + Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "x" { Attribute.value = Obj.magic 2 } + in + let tuple2 : Tuple.materialized = + { relation = "items"; attributes = attrs2 } + in - (* Get relation from database - it's now integrated! *) - let relation = match Manipulation.Memory.get_relation db ~name:"items" with - | None -> assert false - | Some r -> r - in + (* Get relation from database - it's now integrated! *) + let relation = + match Manipulation.Memory.get_relation db ~name:"items" with + | None -> assert false + | Some r -> r + in - let (db, _relation, _) = match Manipulation.Memory.create_tuple storage db relation tuple2 with - | Error _ -> assert false - | Ok x -> x - in + let db, _relation, _ = + match Manipulation.Memory.create_tuple storage db relation tuple2 with + | Error _ -> assert false + | Ok x -> x + in - let h2 = db.hash in - assert (h1 <> h2); + let h2 = db.hash in + assert (h1 <> h2); - (* Now load H1 from storage - should get database state with 1 tuple *) - match Manipulation.Memory.load_database storage h1 with - | Error _ -> assert false - | Ok None -> assert false - | Ok (Some loaded_db) -> - assert (loaded_db.hash = h1); - assert (loaded_db.name = "test"); - (* The relation is now loaded directly in the database *) - match Manipulation.Memory.get_relation loaded_db ~name:"items" with - | None -> assert false - | Some loaded_rel -> - (* Should have 1 tuple *) - assert (Manipulation.Memory.tuple_count loaded_rel = 1)) + (* Now load H1 from storage - should get database state with 1 tuple *) + match Manipulation.Memory.load_database storage h1 with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some loaded_db) -> ( + assert (loaded_db.hash = h1); + assert (loaded_db.name = "test"); + (* The relation is now loaded directly in the database *) + match Manipulation.Memory.get_relation loaded_db ~name:"items" with + | None -> assert false + | Some loaded_rel -> + (* Should have 1 tuple *) + assert (Manipulation.Memory.tuple_count loaded_rel = 1))) let%test_unit "branching: branch from historical state" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty in + let db = + match Manipulation.Memory.create_database storage ~name:"test" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty in - (* Create relation *) - let (db, relation) = match Manipulation.Memory.create_relation storage db ~name:"data" ~schema with - | Error _ -> assert false - | Ok x -> x - in + (* Create relation *) + let db, relation = + match + Manipulation.Memory.create_relation storage db ~name:"data" ~schema + with + | Error _ -> assert false + | Ok x -> x + in - (* Add tuple A *) - let tuple_a : Tuple.materialized = { - relation = "data"; - attributes = Tuple.AttributeMap.singleton "v" { Attribute.value = Obj.magic "A" } - } in - let (db, relation, _) = match Manipulation.Memory.create_tuple storage db relation tuple_a with - | Error _ -> assert false - | Ok x -> x - in + (* Add tuple A *) + let tuple_a : Tuple.materialized = + { + relation = "data"; + attributes = + Tuple.AttributeMap.singleton "v" { Attribute.value = Obj.magic "A" }; + } + in + let db, relation, _ = + match Manipulation.Memory.create_tuple storage db relation tuple_a with + | Error _ -> assert false + | Ok x -> x + in - (* Capture H1 - state with tuple A *) - let h1 = db.hash in + (* Capture H1 - state with tuple A *) + let h1 = db.hash in - (* Continue on main branch: add tuple B *) - let tuple_b : Tuple.materialized = { - relation = "data"; - attributes = Tuple.AttributeMap.singleton "v" { Attribute.value = Obj.magic "B" } - } in - let (db_main, relation_main, _) = match Manipulation.Memory.create_tuple storage db relation tuple_b with - | Error _ -> assert false - | Ok x -> x - in - let h2 = db_main.hash in + (* Continue on main branch: add tuple B *) + let tuple_b : Tuple.materialized = + { + relation = "data"; + attributes = + Tuple.AttributeMap.singleton "v" { Attribute.value = Obj.magic "B" }; + } + in + let db_main, relation_main, _ = + match Manipulation.Memory.create_tuple storage db relation tuple_b with + | Error _ -> assert false + | Ok x -> x + in + let h2 = db_main.hash in - (* Now branch from H1 and add tuple C instead *) - let db_branch = match Manipulation.Memory.load_database storage h1 with - | Error _ -> assert false - | Ok None -> assert false - | Ok (Some d) -> d - in - (* Relation is now loaded directly in the database *) - let relation_branch = match Manipulation.Memory.get_relation db_branch ~name:"data" with - | None -> assert false - | Some r -> r - in + (* Now branch from H1 and add tuple C instead *) + let db_branch = + match Manipulation.Memory.load_database storage h1 with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some d) -> d + in + (* Relation is now loaded directly in the database *) + let relation_branch = + match Manipulation.Memory.get_relation db_branch ~name:"data" with + | None -> assert false + | Some r -> r + in - let tuple_c : Tuple.materialized = { - relation = "data"; - attributes = Tuple.AttributeMap.singleton "v" { Attribute.value = Obj.magic "C" } - } in - let (db_branch, _relation_branch, _) = match Manipulation.Memory.create_tuple storage db_branch relation_branch tuple_c with - | Error _ -> assert false - | Ok x -> x - in - let h3 = db_branch.hash in + let tuple_c : Tuple.materialized = + { + relation = "data"; + attributes = + Tuple.AttributeMap.singleton "v" { Attribute.value = Obj.magic "C" }; + } + in + let db_branch, _relation_branch, _ = + match + Manipulation.Memory.create_tuple storage db_branch relation_branch + tuple_c + with + | Error _ -> assert false + | Ok x -> x + in + let h3 = db_branch.hash in - (* Verify: H1, H2, H3 are all different *) - assert (h1 <> h2); - assert (h1 <> h3); - assert (h2 <> h3); + (* Verify: H1, H2, H3 are all different *) + assert (h1 <> h2); + assert (h1 <> h3); + assert (h2 <> h3); - (* H2 (main branch) has tuples A and B *) - assert (Manipulation.Memory.tuple_count relation_main = 2); + (* H2 (main branch) has tuples A and B *) + assert (Manipulation.Memory.tuple_count relation_main = 2); - (* H1 is still loadable and unchanged *) - match Manipulation.Memory.load_database storage h1 with - | Error _ -> assert false - | Ok None -> assert false - | Ok (Some loaded_h1) -> - match Manipulation.Memory.get_relation loaded_h1 ~name:"data" with - | None -> assert false - | Some r -> - assert (Manipulation.Memory.tuple_count r = 1)) + (* H1 is still loadable and unchanged *) + match Manipulation.Memory.load_database storage h1 with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some loaded_h1) -> ( + match Manipulation.Memory.get_relation loaded_h1 ~name:"data" with + | None -> assert false + | Some r -> assert (Manipulation.Memory.tuple_count r = 1))) let%test_unit "branching: full reconstruction from hash" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"shop" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty in - - (* Create relation *) - let (db, relation) = match Manipulation.Memory.create_relation storage db ~name:"products" ~schema with - | Error _ -> assert false - | Ok x -> x - in + let db = + match Manipulation.Memory.create_database storage ~name:"shop" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty in + + (* Create relation *) + let db, relation = + match + Manipulation.Memory.create_relation storage db ~name:"products" + ~schema + with + | Error _ -> assert false + | Ok x -> x + in - (* Add products *) - let make_product name = - { Tuple.relation = "products"; - attributes = Tuple.AttributeMap.singleton "name" { Attribute.value = Obj.magic name } } - in - let (db, _relation, _) = match Manipulation.Memory.create_tuples storage db relation - [make_product "Apple"; make_product "Banana"; make_product "Cherry"] with - | Error _ -> assert false - | Ok x -> x - in + (* Add products *) + let make_product name = + { + Tuple.relation = "products"; + attributes = + Tuple.AttributeMap.singleton "name" + { Attribute.value = Obj.magic name }; + } + in + let db, _relation, _ = + match + Manipulation.Memory.create_tuples storage db relation + [ + make_product "Apple"; make_product "Banana"; make_product "Cherry"; + ] + with + | Error _ -> assert false + | Ok x -> x + in - let saved_hash = db.hash in + let saved_hash = db.hash in - (* Now reconstruct everything from just the hash *) - match Manipulation.Memory.load_database storage saved_hash with - | Error _ -> assert false - | Ok None -> assert false - | Ok (Some loaded_db) -> - (* Relation is now loaded directly in the database *) - match Manipulation.Memory.get_relation loaded_db ~name:"products" with - | None -> assert false - | Some loaded_rel -> - (* Get tuple hashes from relation *) - let tuple_hashes = Manipulation.Memory.tuple_hashes loaded_rel in - assert (List.length tuple_hashes = 3); - - (* Load all tuples *) - match Manipulation.Memory.load_tuples storage tuple_hashes with - | Error _ -> assert false - | Ok tuples -> - assert (List.length tuples = 3); - let names = List.map (fun t -> - let attr = Tuple.AttributeMap.find "name" t.Tuple.attributes in - (Obj.magic attr.Attribute.value : string) - ) tuples in - assert (List.mem "Apple" names); - assert (List.mem "Banana" names); - assert (List.mem "Cherry" names)) + (* Now reconstruct everything from just the hash *) + match Manipulation.Memory.load_database storage saved_hash with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some loaded_db) -> ( + (* Relation is now loaded directly in the database *) + match Manipulation.Memory.get_relation loaded_db ~name:"products" with + | None -> assert false + | Some loaded_rel -> ( + (* Get tuple hashes from relation *) + let tuple_hashes = Manipulation.Memory.tuple_hashes loaded_rel in + assert (List.length tuple_hashes = 3); + + (* Load all tuples *) + match Manipulation.Memory.load_tuples storage tuple_hashes with + | Error _ -> assert false + | Ok tuples -> + assert (List.length tuples = 3); + let names = + List.map + (fun t -> + let attr = + Tuple.AttributeMap.find "name" t.Tuple.attributes + in + (Obj.magic attr.Attribute.value : string)) + tuples + in + assert (List.mem "Apple" names); + assert (List.mem "Banana" names); + assert (List.mem "Cherry" names)))) (* Helper: build a materialized tuple with int attributes *) let make_int_tuple relation pairs = let attributes = - List.fold_left (fun acc (k, v) -> - Tuple.AttributeMap.add k { Attribute.value = Obj.repr (v : int) } acc) + List.fold_left + (fun acc (k, v) -> + Tuple.AttributeMap.add k { Attribute.value = Obj.repr (v : int) } acc) Tuple.AttributeMap.empty pairs in (Tuple.Materialized { Tuple.relation; attributes } : Tuple.t) @@ -1024,289 +1257,429 @@ let make_int_tuple relation pairs = (* Helper: build a stored relation with one integer column and given values *) let stored_relation_with_ints storage db ~name ~attr values = let schema = Schema.empty |> Schema.add attr "integer" in - let (db, rel) = match Manipulation.Memory.create_relation storage db ~name ~schema with - | Error _ -> assert false | Ok x -> x + let db, rel = + match Manipulation.Memory.create_relation storage db ~name ~schema with + | Error _ -> assert false + | Ok x -> x in - let tuples = List.map (fun v -> - let attributes = - Tuple.AttributeMap.singleton attr { Attribute.value = Obj.repr (v : int) } - in - ({ Tuple.relation = name; attributes } : Tuple.materialized) - ) values in - let (db, rel, _) = match Manipulation.Memory.create_tuples storage db rel tuples with - | Error _ -> assert false | Ok x -> x + let tuples = + List.map + (fun v -> + let attributes = + Tuple.AttributeMap.singleton attr + { Attribute.value = Obj.repr (v : int) } + in + ({ Tuple.relation = name; attributes } : Tuple.materialized)) + values + in + let db, rel, _ = + match Manipulation.Memory.create_tuples storage db rel tuples with + | Error _ -> assert false + | Ok x -> x in (db, rel) let%test_unit "algebra: const_relation single tuple" = with_storage (fun storage -> - let rel = Algebra.Memory.const_relation - [ "x", Obj.repr (42 : int); - "y", Obj.repr (99 : int) ] in - match Algebra.Memory.materialize storage rel with - | Error _ -> assert false - | Ok [tup] -> - let x: int = Obj.obj (Tuple.AttributeMap.find "x" tup.Tuple.attributes).Attribute.value in - assert (x = 42) - | Ok _ -> assert false) + let rel = + Algebra.Memory.const_relation + [ ("x", Obj.repr (42 : int)); ("y", Obj.repr (99 : int)) ] + in + match Algebra.Memory.materialize storage rel with + | Error _ -> assert false + | Ok [ tup ] -> + let x : int = + Obj.obj + (Tuple.AttributeMap.find "x" tup.Tuple.attributes).Attribute.value + in + assert (x = 42) + | Ok _ -> assert false) let%test_unit "algebra: select_fn with predicate" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let (_, rel) = stored_relation_with_ints storage db ~name:"nums" ~attr:"n" [1;2;3;4;5] in - let predicate = function - | Tuple.Materialized t -> - let v: int = Obj.obj (Tuple.AttributeMap.find "n" t.Tuple.attributes).Attribute.value in - v > 3 - | _ -> false - in - match Algebra.Memory.select_fn storage predicate rel with - | Error _ -> assert false - | Ok result -> - match Algebra.Memory.materialize storage result with + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db + in + let _, rel = + stored_relation_with_ints storage db ~name:"nums" ~attr:"n" + [ 1; 2; 3; 4; 5 ] + in + let predicate = function + | Tuple.Materialized t -> + let v : int = + Obj.obj + (Tuple.AttributeMap.find "n" t.Tuple.attributes).Attribute.value + in + v > 3 + | _ -> false + in + match Algebra.Memory.select_fn storage predicate rel with | Error _ -> assert false - | Ok rows -> - assert (List.length rows = 2); - List.iter (fun t -> - let v: int = Obj.obj (Tuple.AttributeMap.find "n" t.Tuple.attributes).Attribute.value in - assert (v > 3)) rows) + | Ok result -> ( + match Algebra.Memory.materialize storage result with + | Error _ -> assert false + | Ok rows -> + assert (List.length rows = 2); + List.iter + (fun t -> + let v : int = + Obj.obj + (Tuple.AttributeMap.find "n" t.Tuple.attributes) + .Attribute.value + in + assert (v > 3)) + rows)) let%test_unit "algebra: project restricts schema" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty |> Schema.add "a" "integer" |> Schema.add "b" "integer" in - let (db, rel) = match Manipulation.Memory.create_relation storage db ~name:"ab" ~schema with - | Error _ -> assert false | Ok x -> x - in - let attrs = Tuple.AttributeMap.empty - |> Tuple.AttributeMap.add "a" { Attribute.value = Obj.repr (1 : int) } - |> Tuple.AttributeMap.add "b" { Attribute.value = Obj.repr (2 : int) } in - let (_, rel, _) = match Manipulation.Memory.create_tuple storage db rel - { Tuple.relation = "ab"; attributes = attrs } with - | Error _ -> assert false | Ok x -> x - in - match Algebra.Memory.project storage ["a"] rel with - | Error _ -> assert false - | Ok projected -> - match Algebra.Memory.materialize storage projected with + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db + in + let schema = + Schema.empty |> Schema.add "a" "integer" |> Schema.add "b" "integer" + in + let db, rel = + match + Manipulation.Memory.create_relation storage db ~name:"ab" ~schema + with + | Error _ -> assert false + | Ok x -> x + in + let attrs = + Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "a" { Attribute.value = Obj.repr (1 : int) } + |> Tuple.AttributeMap.add "b" { Attribute.value = Obj.repr (2 : int) } + in + let _, rel, _ = + match + Manipulation.Memory.create_tuple storage db rel + { Tuple.relation = "ab"; attributes = attrs } + with + | Error _ -> assert false + | Ok x -> x + in + match Algebra.Memory.project storage [ "a" ] rel with | Error _ -> assert false - | Ok [t] -> - assert (Tuple.AttributeMap.mem "a" t.Tuple.attributes); - assert (not (Tuple.AttributeMap.mem "b" t.Tuple.attributes)) - | Ok _ -> assert false) + | Ok projected -> ( + match Algebra.Memory.materialize storage projected with + | Error _ -> assert false + | Ok [ t ] -> + assert (Tuple.AttributeMap.mem "a" t.Tuple.attributes); + assert (not (Tuple.AttributeMap.mem "b" t.Tuple.attributes)) + | Ok _ -> assert false)) let%test_unit "algebra: rename changes attr names" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let (_, rel) = stored_relation_with_ints storage db ~name:"r" ~attr:"x" [7] in - match Algebra.Memory.rename storage [("x", "y")] rel with - | Error _ -> assert false - | Ok renamed -> - match Algebra.Memory.materialize storage renamed with - | Error _ -> assert false - | Ok [t] -> - assert (not (Tuple.AttributeMap.mem "x" t.Tuple.attributes)); - assert (Tuple.AttributeMap.mem "y" t.Tuple.attributes); - let v: int = Obj.obj (Tuple.AttributeMap.find "y" t.Tuple.attributes).Attribute.value in - assert (v = 7) - | Ok _ -> assert false) + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db + in + let _, rel = + stored_relation_with_ints storage db ~name:"r" ~attr:"x" [ 7 ] + in + match Algebra.Memory.rename storage [ ("x", "y") ] rel with + | Error _ -> assert false + | Ok renamed -> ( + match Algebra.Memory.materialize storage renamed with + | Error _ -> assert false + | Ok [ t ] -> + assert (not (Tuple.AttributeMap.mem "x" t.Tuple.attributes)); + assert (Tuple.AttributeMap.mem "y" t.Tuple.attributes); + let v : int = + Obj.obj + (Tuple.AttributeMap.find "y" t.Tuple.attributes) + .Attribute.value + in + assert (v = 7) + | Ok _ -> assert false)) let%test_unit "algebra: equijoin merges matching tuples" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - (* left: {id=1, name="Alice"}, {id=2, name="Bob"} *) - let schema_l = Schema.empty |> Schema.add "id" "integer" |> Schema.add "name" "string" in - let (db, left) = match Manipulation.Memory.create_relation storage db ~name:"L" ~schema:schema_l with - | Error _ -> assert false | Ok x -> x - in - let make_left id name = - let attrs = Tuple.AttributeMap.empty - |> Tuple.AttributeMap.add "id" { Attribute.value = Obj.repr (id : int) } - |> Tuple.AttributeMap.add "name" { Attribute.value = Obj.repr (name : string) } in - ({ Tuple.relation = "L"; attributes = attrs } : Tuple.materialized) - in - let (db, left, _) = match Manipulation.Memory.create_tuples storage db left - [make_left 1 "Alice"; make_left 2 "Bob"] with - | Error _ -> assert false | Ok x -> x - in - (* right: {id=1, score=100}, {id=3, score=999} *) - let schema_r = Schema.empty |> Schema.add "id" "integer" |> Schema.add "score" "integer" in - let (db, right) = match Manipulation.Memory.create_relation storage db ~name:"R" ~schema:schema_r with - | Error _ -> assert false | Ok x -> x - in - let make_right id score = - let attrs = Tuple.AttributeMap.empty - |> Tuple.AttributeMap.add "id" { Attribute.value = Obj.repr (id : int) } - |> Tuple.AttributeMap.add "score" { Attribute.value = Obj.repr (score : int) } in - ({ Tuple.relation = "R"; attributes = attrs } : Tuple.materialized) - in - let (_, right, _) = match Manipulation.Memory.create_tuples storage db right - [make_right 1 100; make_right 3 999] with - | Error _ -> assert false | Ok x -> x - in - match Algebra.Memory.equijoin storage ["id"] left right with - | Error _ -> assert false - | Ok joined -> - match Algebra.Memory.materialize storage joined with - | Error _ -> assert false - | Ok rows -> - (* Only id=1 matches *) - assert (List.length rows = 1); - let t = List.hd rows in - let score: int = Obj.obj (Tuple.AttributeMap.find "score" t.Tuple.attributes).Attribute.value in - assert (score = 100)) + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db + in + (* left: {id=1, name="Alice"}, {id=2, name="Bob"} *) + let schema_l = + Schema.empty |> Schema.add "id" "integer" |> Schema.add "name" "string" + in + let db, left = + match + Manipulation.Memory.create_relation storage db ~name:"L" + ~schema:schema_l + with + | Error _ -> assert false + | Ok x -> x + in + let make_left id name = + let attrs = + Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "id" + { Attribute.value = Obj.repr (id : int) } + |> Tuple.AttributeMap.add "name" + { Attribute.value = Obj.repr (name : string) } + in + ({ Tuple.relation = "L"; attributes = attrs } : Tuple.materialized) + in + let db, left, _ = + match + Manipulation.Memory.create_tuples storage db left + [ make_left 1 "Alice"; make_left 2 "Bob" ] + with + | Error _ -> assert false + | Ok x -> x + in + (* right: {id=1, score=100}, {id=3, score=999} *) + let schema_r = + Schema.empty |> Schema.add "id" "integer" + |> Schema.add "score" "integer" + in + let db, right = + match + Manipulation.Memory.create_relation storage db ~name:"R" + ~schema:schema_r + with + | Error _ -> assert false + | Ok x -> x + in + let make_right id score = + let attrs = + Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "id" + { Attribute.value = Obj.repr (id : int) } + |> Tuple.AttributeMap.add "score" + { Attribute.value = Obj.repr (score : int) } + in + ({ Tuple.relation = "R"; attributes = attrs } : Tuple.materialized) + in + let _, right, _ = + match + Manipulation.Memory.create_tuples storage db right + [ make_right 1 100; make_right 3 999 ] + with + | Error _ -> assert false + | Ok x -> x + in + match Algebra.Memory.equijoin storage [ "id" ] left right with + | Error _ -> assert false + | Ok joined -> ( + match Algebra.Memory.materialize storage joined with + | Error _ -> assert false + | Ok rows -> + (* Only id=1 matches *) + assert (List.length rows = 1); + let t = List.hd rows in + let score : int = + Obj.obj + (Tuple.AttributeMap.find "score" t.Tuple.attributes) + .Attribute.value + in + assert (score = 100))) let%test_unit "algebra: equijoin empty match" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let (db, left) = stored_relation_with_ints storage db ~name:"L" ~attr:"id" [1;2] in - let (_, right) = stored_relation_with_ints storage db ~name:"R" ~attr:"id" [9;8] in - match Algebra.Memory.equijoin storage ["id"] left right with - | Error _ -> assert false - | Ok joined -> - match Algebra.Memory.materialize storage joined with + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db + in + let db, left = + stored_relation_with_ints storage db ~name:"L" ~attr:"id" [ 1; 2 ] + in + let _, right = + stored_relation_with_ints storage db ~name:"R" ~attr:"id" [ 9; 8 ] + in + match Algebra.Memory.equijoin storage [ "id" ] left right with | Error _ -> assert false - | Ok rows -> assert (List.length rows = 0)) + | Ok joined -> ( + match Algebra.Memory.materialize storage joined with + | Error _ -> assert false + | Ok rows -> assert (List.length rows = 0))) let%test_unit "algebra: union concatenates streams" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let (db, r1) = stored_relation_with_ints storage db ~name:"A" ~attr:"n" [1;2] in - let (_, r2) = stored_relation_with_ints storage db ~name:"B" ~attr:"n" [3;4] in - match Algebra.Memory.union storage r1 r2 with - | Error _ -> assert false - | Ok unioned -> - match Algebra.Memory.materialize storage unioned with - | Error _ -> assert false - | Ok rows -> - assert (List.length rows = 4); - let vals = List.map (fun t -> - Obj.obj (Tuple.AttributeMap.find "n" t.Tuple.attributes).Attribute.value - ) rows in - assert (List.mem 1 vals); - assert (List.mem 2 vals); - assert (List.mem 3 vals); - assert (List.mem 4 vals)) + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db + in + let db, r1 = + stored_relation_with_ints storage db ~name:"A" ~attr:"n" [ 1; 2 ] + in + let _, r2 = + stored_relation_with_ints storage db ~name:"B" ~attr:"n" [ 3; 4 ] + in + match Algebra.Memory.union storage r1 r2 with + | Error _ -> assert false + | Ok unioned -> ( + match Algebra.Memory.materialize storage unioned with + | Error _ -> assert false + | Ok rows -> + assert (List.length rows = 4); + let vals = + List.map + (fun t -> + Obj.obj + (Tuple.AttributeMap.find "n" t.Tuple.attributes) + .Attribute.value) + rows + in + assert (List.mem 1 vals); + assert (List.mem 2 vals); + assert (List.mem 3 vals); + assert (List.mem 4 vals))) let%test_unit "algebra: diff removes right from left" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let (db, r1) = stored_relation_with_ints storage db ~name:"A" ~attr:"n" [1;2;3] in - let (_, r2) = stored_relation_with_ints storage db ~name:"B" ~attr:"n" [2;3] in - match Algebra.Memory.diff storage r1 r2 with - | Error _ -> assert false - | Ok result -> - match Algebra.Memory.materialize storage result with - | Error _ -> assert false - | Ok rows -> - assert (List.length rows = 1); - let v: int = Obj.obj (Tuple.AttributeMap.find "n" (List.hd rows).Tuple.attributes).Attribute.value in - assert (v = 1)) + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db + in + let db, r1 = + stored_relation_with_ints storage db ~name:"A" ~attr:"n" [ 1; 2; 3 ] + in + let _, r2 = + stored_relation_with_ints storage db ~name:"B" ~attr:"n" [ 2; 3 ] + in + match Algebra.Memory.diff storage r1 r2 with + | Error _ -> assert false + | Ok result -> ( + match Algebra.Memory.materialize storage result with + | Error _ -> assert false + | Ok rows -> + assert (List.length rows = 1); + let v : int = + Obj.obj + (Tuple.AttributeMap.find "n" (List.hd rows).Tuple.attributes) + .Attribute.value + in + assert (v = 1))) let%test_unit "algebra: take limits output" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let (_, rel) = stored_relation_with_ints storage db ~name:"big" ~attr:"n" [10;20;30;40;50] in - match Algebra.Memory.take storage 3 rel with - | Error _ -> assert false - | Ok result -> - match Algebra.Memory.materialize storage result with + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db + in + let _, rel = + stored_relation_with_ints storage db ~name:"big" ~attr:"n" + [ 10; 20; 30; 40; 50 ] + in + match Algebra.Memory.take storage 3 rel with | Error _ -> assert false - | Ok rows -> assert (List.length rows = 3)) + | Ok result -> ( + match Algebra.Memory.materialize storage result with + | Error _ -> assert false + | Ok rows -> assert (List.length rows = 3))) let%test_unit "drl: parse Base" = match Drl.Parser.of_string {|(Base "users")|} with - | Error _ -> assert false - | Ok (Drl.Ast.Base s) -> assert (s = "users") - | Ok _ -> assert false + | Error _ -> assert false + | Ok (Drl.Ast.Base s) -> assert (s = "users") + | Ok _ -> assert false let%test_unit "drl: parse Const" = match Drl.Parser.of_string {|(Const (("age" (Int 18))))|} with - | Error _ -> assert false - | Ok (Drl.Ast.Const [("age", Drl.Ast.Int 18)]) -> () - | Ok _ -> assert false + | Error _ -> assert false + | Ok (Drl.Ast.Const [ ("age", Drl.Ast.Int 18) ]) -> () + | Ok _ -> assert false let%test_unit "drl: parse Join" = match Drl.Parser.of_string {|(Join (id) (Base "L") (Base "R"))|} with - | Error _ -> assert false - | Ok (Drl.Ast.Join (["id"], Drl.Ast.Base "L", Drl.Ast.Base "R")) -> () - | Ok _ -> assert false + | Error _ -> assert false + | Ok (Drl.Ast.Join ([ "id" ], Drl.Ast.Base "L", Drl.Ast.Base "R")) -> () + | Ok _ -> assert false let%test_unit "drl: parse Select" = let s = {|(Select (Const (("age" (Int 18)))) (Base "users"))|} in match Drl.Parser.of_string s with | Error _ -> assert false | Ok (Drl.Ast.Select (Drl.Ast.Const _, Drl.Ast.Base "users")) -> () - | Ok _ -> assert false + | Ok _ -> assert false let%test_unit "drl: execute Base" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - let (db, _) = stored_relation_with_ints storage db ~name:"items" ~attr:"v" [10; 20] in - match Drl.Parser.of_string {|(Base "items")|} with - | Error _ -> assert false - | Ok query -> - match Drl.Executor.Memory.execute storage db query with - | Error _ -> assert false - | Ok rel -> - match Algebra.Memory.materialize storage rel with + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with | Error _ -> assert false - | Ok rows -> assert (List.length rows = 2)) + | Ok db -> db + in + let db, _ = + stored_relation_with_ints storage db ~name:"items" ~attr:"v" [ 10; 20 ] + in + match Drl.Parser.of_string {|(Base "items")|} with + | Error _ -> assert false + | Ok query -> ( + match Drl.Executor.Memory.execute storage db query with + | Error _ -> assert false + | Ok rel -> ( + match Algebra.Memory.materialize storage rel with + | Error _ -> assert false + | Ok rows -> assert (List.length rows = 2)))) let%test_unit "drl: execute Select+Const" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"test_db" with - | Error _ -> assert false | Ok db -> db - in - (* users: {age=18, name="Alice"}, {age=25, name="Bob"} *) - let schema = Schema.empty |> Schema.add "age" "integer" |> Schema.add "name" "string" in - let (db, users) = match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with - | Error _ -> assert false | Ok x -> x - in - let make_user age name = - let attrs = Tuple.AttributeMap.empty - |> Tuple.AttributeMap.add "age" { Attribute.value = Obj.repr (age : int) } - |> Tuple.AttributeMap.add "name" { Attribute.value = Obj.repr (name : string) } in - ({ Tuple.relation = "users"; attributes = attrs } : Tuple.materialized) - in - let (db, _, _) = match Manipulation.Memory.create_tuples storage db users - [make_user 18 "Alice"; make_user 25 "Bob"] with - | Error _ -> assert false | Ok x -> x - in - (* Query: select users where age = 18 *) - let s = {|(Select (Const (("age" (Int 18)))) (Base "users"))|} in - match Drl.Parser.of_string s with - | Error _ -> assert false - | Ok query -> - match Drl.Executor.Memory.execute storage db query with - | Error _ -> assert false - | Ok rel -> - match Algebra.Memory.materialize storage rel with - | Error _ -> assert false - | Ok rows -> - assert (List.length rows = 1); - let name_v: string = - Obj.obj (Tuple.AttributeMap.find "name" (List.hd rows).Tuple.attributes).Attribute.value - in - assert (name_v = "Alice")) + let db = + match Manipulation.Memory.create_database storage ~name:"test_db" with + | Error _ -> assert false + | Ok db -> db + in + (* users: {age=18, name="Alice"}, {age=25, name="Bob"} *) + let schema = + Schema.empty |> Schema.add "age" "integer" |> Schema.add "name" "string" + in + let db, users = + match + Manipulation.Memory.create_relation storage db ~name:"users" ~schema + with + | Error _ -> assert false + | Ok x -> x + in + let make_user age name = + let attrs = + Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "age" + { Attribute.value = Obj.repr (age : int) } + |> Tuple.AttributeMap.add "name" + { Attribute.value = Obj.repr (name : string) } + in + ({ Tuple.relation = "users"; attributes = attrs } : Tuple.materialized) + in + let db, _, _ = + match + Manipulation.Memory.create_tuples storage db users + [ make_user 18 "Alice"; make_user 25 "Bob" ] + with + | Error _ -> assert false + | Ok x -> x + in + (* Query: select users where age = 18 *) + let s = {|(Select (Const (("age" (Int 18)))) (Base "users"))|} in + match Drl.Parser.of_string s with + | Error _ -> assert false + | Ok query -> ( + match Drl.Executor.Memory.execute storage db query with + | Error _ -> assert false + | Ok rel -> ( + match Algebra.Memory.materialize storage rel with + | Error _ -> assert false + | Ok rows -> + assert (List.length rows = 1); + let name_v : string = + Obj.obj + (Tuple.AttributeMap.find "name" + (List.hd rows).Tuple.attributes) + .Attribute.value + in + assert (name_v = "Alice")))) (* ---------- Constraint construction ---------- *) @@ -1322,12 +1695,8 @@ let%test_unit "constraint: vars_in MemberOf" = assert (not (List.mem "right" vars)) let%test_unit "constraint: vars_in And" = - let b1 = - Constraint.BindingMap.singleton "left" (Constraint.Var "a") - in - let b2 = - Constraint.BindingMap.singleton "left" (Constraint.Var "b") - in + let b1 = Constraint.BindingMap.singleton "left" (Constraint.Var "a") in + let b2 = Constraint.BindingMap.singleton "left" (Constraint.Var "b") in let c = Constraint.And [ @@ -1340,9 +1709,7 @@ let%test_unit "constraint: vars_in And" = assert (List.mem "b" vars) let%test_unit "constraint: rename_vars" = - let b = - Constraint.BindingMap.singleton "left" (Constraint.Var "old_name") - in + let b = Constraint.BindingMap.singleton "left" (Constraint.Var "old_name") in let c = Constraint.MemberOf { target = "t"; binding = b } in let c' = Constraint.rename_vars [ ("old_name", "new_name") ] c in let vars = Constraint.vars_in c' in @@ -1350,9 +1717,7 @@ let%test_unit "constraint: rename_vars" = assert (not (List.mem "old_name" vars)) let%test_unit "constraint: filter_by_attrs keeps relevant" = - let b = - Constraint.BindingMap.singleton "left" (Constraint.Var "x") - in + let b = Constraint.BindingMap.singleton "left" (Constraint.Var "x") in let c = Constraint.MemberOf { target = "t"; binding = b } in assert (Constraint.filter_by_attrs [ "x" ] c <> None); assert (Constraint.filter_by_attrs [ "y" ] c = None) @@ -1399,7 +1764,8 @@ let%test_unit "constraint: lt shorthand" = let%test_unit "constraint: between shorthand" = match - Constraint.between ~value:(Var "x") ~low:(Const (Obj.repr 0)) + Constraint.between ~value:(Var "x") + ~low:(Const (Obj.repr 0)) ~high:(Const (Obj.repr 100)) with | Constraint.And [ _; _ ] -> () @@ -1444,26 +1810,16 @@ let make_eval_ctx ?(relations = []) () : Constraint.eval_context = } let%test_unit "constraint: evaluate MemberOf success" = - let ctx = - make_eval_ctx - ~relations:[ ("my_rel", fun _pairs -> true) ] - () - in + let ctx = make_eval_ctx ~relations:[ ("my_rel", fun _pairs -> true) ] () in let b = Constraint.BindingMap.empty in let c = Constraint.MemberOf { target = "my_rel"; binding = b } in let tuple : Tuple.materialized = { relation = "test"; attributes = Tuple.AttributeMap.empty } in - match Constraint.evaluate ctx tuple c with - | Ok true -> () - | _ -> assert false + match Constraint.evaluate ctx tuple c with Ok true -> () | _ -> assert false let%test_unit "constraint: evaluate MemberOf failure" = - let ctx = - make_eval_ctx - ~relations:[ ("my_rel", fun _pairs -> false) ] - () - in + let ctx = make_eval_ctx ~relations:[ ("my_rel", fun _pairs -> false) ] () in let b = Constraint.BindingMap.empty in let c = Constraint.MemberOf { target = "my_rel"; binding = b } in let tuple : Tuple.materialized = @@ -1502,20 +1858,14 @@ let%test_unit "constraint: evaluate And short-circuits" = { relation = "test"; attributes = Tuple.AttributeMap.empty } in (match Constraint.evaluate ctx tuple c with - | Error _ -> () - | _ -> assert false); + | Error _ -> () + | _ -> assert false); (* Second branch should not have been called *) assert (!call_count = 1) let%test_unit "constraint: evaluate Or succeeds on first match" = let ctx = - make_eval_ctx - ~relations: - [ - ("a", fun _ -> false); - ("b", fun _ -> true); - ] - () + make_eval_ctx ~relations:[ ("a", fun _ -> false); ("b", fun _ -> true) ] () in let b = Constraint.BindingMap.empty in let c = @@ -1528,9 +1878,7 @@ let%test_unit "constraint: evaluate Or succeeds on first match" = let tuple : Tuple.materialized = { relation = "test"; attributes = Tuple.AttributeMap.empty } in - match Constraint.evaluate ctx tuple c with - | Ok true -> () - | _ -> assert false + match Constraint.evaluate ctx tuple c with Ok true -> () | _ -> assert false let%test_unit "constraint: evaluate Not negates" = let ctx : Constraint.eval_context = @@ -1555,16 +1903,14 @@ let%test_unit "constraint: evaluate Not negates" = let tuple : Tuple.materialized = { relation = "test"; attributes = Tuple.AttributeMap.empty } in - match Constraint.evaluate ctx tuple c with - | Ok true -> () - | _ -> assert false + match Constraint.evaluate ctx tuple c with Ok true -> () | _ -> assert false let%test_unit "constraint: evaluate Exists over finite relation" = let ctx : Constraint.eval_context = { check_membership = (fun _rel_name pairs -> - match List.assoc_opt "left" pairs, List.assoc_opt "right" pairs with + match (List.assoc_opt "left" pairs, List.assoc_opt "right" pairs) with | Some l, Some r -> (Obj.obj l : int) < (Obj.obj r : int) | _ -> false); iterate_finite = @@ -1600,26 +1946,20 @@ let%test_unit "constraint: evaluate Exists over finite relation" = Tuple.AttributeMap.singleton "x" { Attribute.value = Obj.repr 3 }; } in - match Constraint.evaluate ctx tuple c with - | Ok true -> () - | _ -> assert false + match Constraint.evaluate ctx tuple c with Ok true -> () | _ -> assert false let%test_unit "constraint: evaluate Forall fails when not all match" = let ctx : Constraint.eval_context = { check_membership = (fun _rel_name pairs -> - match List.assoc_opt "left" pairs, List.assoc_opt "right" pairs with + match (List.assoc_opt "left" pairs, List.assoc_opt "right" pairs) with | Some l, Some r -> (Obj.obj l : int) < (Obj.obj r : int) | _ -> false); iterate_finite = (fun rel_name -> if rel_name = "small_set" then - Some - [ - [ ("value", Obj.repr 1) ]; - [ ("value", Obj.repr 5) ]; - ] + Some [ [ ("value", Obj.repr 1) ]; [ ("value", Obj.repr 5) ] ] else None); } in @@ -1650,10 +1990,7 @@ let%test_unit "constraint: evaluate Forall fails when not all match" = let%test_unit "constraint: Forall unbounded quantifier errors" = let ctx : Constraint.eval_context = - { - check_membership = (fun _ _ -> true); - iterate_finite = (fun _ -> None); - } + { check_membership = (fun _ _ -> true); iterate_finite = (fun _ -> None) } in let b = Constraint.BindingMap.empty in let c = @@ -1675,667 +2012,659 @@ let%test_unit "constraint: Forall unbounded quantifier errors" = let%test_unit "constraint: create_tuple with passing constraint" = with_storage (fun storage -> - let db = - match Manipulation.Memory.create_database storage ~name:"test" with - | Error _ -> assert false - | Ok db -> db - in - let schema = Schema.empty |> Schema.add "value" "natural" in - let db, _rel = - match - Manipulation.Memory.create_relation storage db ~name:"positives" - ~schema - with - | Error _ -> assert false - | Ok x -> x - in - (* Register a constraint: value must be member of natural (always true for naturals) *) - let db = - match - Manipulation.Memory.register_constraint storage db - ~constraint_name:"is_natural" ~relation_name:"positives" - ~body:(Constraint.And []) - with - | Error _ -> assert false - | Ok db -> db - in - let rel = - match Manipulation.Memory.get_relation db ~name:"positives" with - | None -> assert false - | Some r -> r - in - let tuple : Tuple.materialized = - { - relation = "positives"; - attributes = - Tuple.AttributeMap.singleton "value" - { Attribute.value = Obj.repr 5 }; - } - in - match Manipulation.Memory.create_tuple storage db rel tuple with - | Ok _ -> () - | Error _ -> assert false) + let db = + match Manipulation.Memory.create_database storage ~name:"test" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty |> Schema.add "value" "natural" in + let db, _rel = + match + Manipulation.Memory.create_relation storage db ~name:"positives" + ~schema + with + | Error _ -> assert false + | Ok x -> x + in + (* Register a constraint: value must be member of natural (always true for naturals) *) + let db = + match + Manipulation.Memory.register_constraint storage db + ~constraint_name:"is_natural" ~relation_name:"positives" + ~body:(Constraint.And []) + with + | Error _ -> assert false + | Ok db -> db + in + let rel = + match Manipulation.Memory.get_relation db ~name:"positives" with + | None -> assert false + | Some r -> r + in + let tuple : Tuple.materialized = + { + relation = "positives"; + attributes = + Tuple.AttributeMap.singleton "value" + { Attribute.value = Obj.repr 5 }; + } + in + match Manipulation.Memory.create_tuple storage db rel tuple with + | Ok _ -> () + | Error _ -> assert false) let%test_unit "constraint: create_tuple with failing constraint" = with_storage (fun storage -> - let db = - match Manipulation.Memory.create_database storage ~name:"test" with - | Error _ -> assert false - | Ok db -> db - in - let schema = Schema.empty |> Schema.add "value" "natural" in - let db, _rel = - match - Manipulation.Memory.create_relation storage db ~name:"checked" - ~schema - with - | Error _ -> assert false - | Ok x -> x - in - (* Register a constraint that always fails: MemberOf a nonexistent relation *) - let db = - match - Manipulation.Memory.register_constraint storage db - ~constraint_name:"impossible" ~relation_name:"checked" - ~body: - (Constraint.MemberOf - { - target = "nonexistent_relation"; - binding = - Constraint.BindingMap.singleton "x" (Constraint.Var "value"); - }) - with - | Error _ -> assert false - | Ok db -> db - in - let rel = - match Manipulation.Memory.get_relation db ~name:"checked" with - | None -> assert false - | Some r -> r - in - let tuple : Tuple.materialized = - { - relation = "checked"; - attributes = - Tuple.AttributeMap.singleton "value" - { Attribute.value = Obj.repr 5 }; - } - in - match Manipulation.Memory.create_tuple storage db rel tuple with - | Error (Manipulation.ConstraintViolation _) -> () - | _ -> assert false) + let db = + match Manipulation.Memory.create_database storage ~name:"test" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty |> Schema.add "value" "natural" in + let db, _rel = + match + Manipulation.Memory.create_relation storage db ~name:"checked" ~schema + with + | Error _ -> assert false + | Ok x -> x + in + (* Register a constraint that always fails: MemberOf a nonexistent relation *) + let db = + match + Manipulation.Memory.register_constraint storage db + ~constraint_name:"impossible" ~relation_name:"checked" + ~body: + (Constraint.MemberOf + { + target = "nonexistent_relation"; + binding = + Constraint.BindingMap.singleton "x" + (Constraint.Var "value"); + }) + with + | Error _ -> assert false + | Ok db -> db + in + let rel = + match Manipulation.Memory.get_relation db ~name:"checked" with + | None -> assert false + | Some r -> r + in + let tuple : Tuple.materialized = + { + relation = "checked"; + attributes = + Tuple.AttributeMap.singleton "value" + { Attribute.value = Obj.repr 5 }; + } + in + match Manipulation.Memory.create_tuple storage db rel tuple with + | Error (Manipulation.ConstraintViolation _) -> () + | _ -> assert false) (* ---------- Scenario tests ported from Erlang ---------- *) (* Scenario 1: Mutual exclusion between subtypes *) let%test_unit "constraint scenario: mutual exclusion subtypes" = with_storage (fun storage -> - let db = - match Manipulation.Memory.create_database storage ~name:"test" with - | Error _ -> assert false - | Ok db -> db - in - let schema = Schema.empty |> Schema.add "id" "natural" in - let db, _employee = - match - Manipulation.Memory.create_relation storage db ~name:"employee" - ~schema - with - | Error _ -> assert false - | Ok x -> x - in - let db, _manager = - match - Manipulation.Memory.create_relation storage db ~name:"manager" - ~schema - with - | Error _ -> assert false - | Ok x -> x - in - (* manager must NOT be in employee (mutual exclusion) *) - let body = - Constraint.Not + let db = + match Manipulation.Memory.create_database storage ~name:"test" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty |> Schema.add "id" "natural" in + let db, _employee = + match + Manipulation.Memory.create_relation storage db ~name:"employee" + ~schema + with + | Error _ -> assert false + | Ok x -> x + in + let db, _manager = + match + Manipulation.Memory.create_relation storage db ~name:"manager" ~schema + with + | Error _ -> assert false + | Ok x -> x + in + (* manager must NOT be in employee (mutual exclusion) *) + let body = + Constraint.Not + { + body = + Constraint.MemberOf + { + target = "employee"; + binding = + Constraint.BindingMap.singleton "id" (Constraint.Var "id"); + }; + universe = "manager"; + } + in + let db = + match + Manipulation.Memory.register_constraint storage db + ~constraint_name:"not_employee" ~relation_name:"manager" ~body + with + | Error _ -> assert false + | Ok db -> db + in + (* Insert into employee first *) + let employee = + match Manipulation.Memory.get_relation db ~name:"employee" with + | None -> assert false + | Some r -> r + in + let emp_tuple : Tuple.materialized = { - body = - Constraint.MemberOf - { - target = "employee"; - binding = - Constraint.BindingMap.singleton "id" (Constraint.Var "id"); - }; - universe = "manager"; + relation = "employee"; + attributes = + Tuple.AttributeMap.singleton "id" { Attribute.value = Obj.repr 1 }; } - in - let db = - match - Manipulation.Memory.register_constraint storage db - ~constraint_name:"not_employee" ~relation_name:"manager" ~body - with - | Error _ -> assert false - | Ok db -> db - in - (* Insert into employee first *) - let employee = - match Manipulation.Memory.get_relation db ~name:"employee" with - | None -> assert false - | Some r -> r - in - let emp_tuple : Tuple.materialized = - { - relation = "employee"; - attributes = - Tuple.AttributeMap.singleton "id" - { Attribute.value = Obj.repr 1 }; - } - in - let db, _employee, _ = - match - Manipulation.Memory.create_tuple storage db employee emp_tuple - with - | Error _ -> assert false - | Ok x -> x - in - (* Now try to insert same id into manager, should fail *) - let manager = - match Manipulation.Memory.get_relation db ~name:"manager" with - | None -> assert false - | Some r -> r - in - let mgr_tuple : Tuple.materialized = - { - relation = "manager"; - attributes = - Tuple.AttributeMap.singleton "id" - { Attribute.value = Obj.repr 1 }; - } - in - match Manipulation.Memory.create_tuple storage db manager mgr_tuple with - | Error (Manipulation.ConstraintViolation _) -> () - | _ -> assert false) + in + let db, _employee, _ = + match + Manipulation.Memory.create_tuple storage db employee emp_tuple + with + | Error _ -> assert false + | Ok x -> x + in + (* Now try to insert same id into manager, should fail *) + let manager = + match Manipulation.Memory.get_relation db ~name:"manager" with + | None -> assert false + | Some r -> r + in + let mgr_tuple : Tuple.materialized = + { + relation = "manager"; + attributes = + Tuple.AttributeMap.singleton "id" { Attribute.value = Obj.repr 1 }; + } + in + match Manipulation.Memory.create_tuple storage db manager mgr_tuple with + | Error (Manipulation.ConstraintViolation _) -> () + | _ -> assert false) (* Scenario 2: Foreign key constraint *) let%test_unit "constraint scenario: foreign key" = with_storage (fun storage -> - let db = - match Manipulation.Memory.create_database storage ~name:"test" with - | Error _ -> assert false - | Ok db -> db - in - let order_schema = Schema.empty |> Schema.add "order_id" "natural" in - let db, _orders = - match - Manipulation.Memory.create_relation storage db ~name:"orders" - ~schema:order_schema - with - | Error _ -> assert false - | Ok x -> x - in - let item_schema = - Schema.empty |> Schema.add "item_id" "natural" - |> Schema.add "order_id" "natural" - in - let db, _items = - match - Manipulation.Memory.create_relation storage db ~name:"order_items" - ~schema:item_schema - with - | Error _ -> assert false - | Ok x -> x - in - (* FK: order_items.order_id must exist in orders *) - let fk_body = - Constraint.MemberOf + let db = + match Manipulation.Memory.create_database storage ~name:"test" with + | Error _ -> assert false + | Ok db -> db + in + let order_schema = Schema.empty |> Schema.add "order_id" "natural" in + let db, _orders = + match + Manipulation.Memory.create_relation storage db ~name:"orders" + ~schema:order_schema + with + | Error _ -> assert false + | Ok x -> x + in + let item_schema = + Schema.empty + |> Schema.add "item_id" "natural" + |> Schema.add "order_id" "natural" + in + let db, _items = + match + Manipulation.Memory.create_relation storage db ~name:"order_items" + ~schema:item_schema + with + | Error _ -> assert false + | Ok x -> x + in + (* FK: order_items.order_id must exist in orders *) + let fk_body = + Constraint.MemberOf + { + target = "orders"; + binding = + Constraint.BindingMap.singleton "order_id" + (Constraint.Var "order_id"); + } + in + let db = + match + Manipulation.Memory.register_constraint storage db + ~constraint_name:"fk_order" ~relation_name:"order_items" + ~body:fk_body + with + | Error _ -> assert false + | Ok db -> db + in + (* Insert an order *) + let orders = + match Manipulation.Memory.get_relation db ~name:"orders" with + | None -> assert false + | Some r -> r + in + let order_tuple : Tuple.materialized = { - target = "orders"; - binding = - Constraint.BindingMap.singleton "order_id" - (Constraint.Var "order_id"); + relation = "orders"; + attributes = + Tuple.AttributeMap.singleton "order_id" + { Attribute.value = Obj.repr 100 }; } - in - let db = - match - Manipulation.Memory.register_constraint storage db - ~constraint_name:"fk_order" ~relation_name:"order_items" - ~body:fk_body - with - | Error _ -> assert false - | Ok db -> db - in - (* Insert an order *) - let orders = - match Manipulation.Memory.get_relation db ~name:"orders" with - | None -> assert false - | Some r -> r - in - let order_tuple : Tuple.materialized = - { - relation = "orders"; - attributes = - Tuple.AttributeMap.singleton "order_id" - { Attribute.value = Obj.repr 100 }; - } - in - let db, _orders, _ = - match - Manipulation.Memory.create_tuple storage db orders order_tuple - with - | Error _ -> assert false - | Ok x -> x - in - (* Insert item referencing valid order, should succeed *) - let items = - match Manipulation.Memory.get_relation db ~name:"order_items" with - | None -> assert false - | Some r -> r - in - let valid_item : Tuple.materialized = - { - relation = "order_items"; - attributes = - Tuple.AttributeMap.of_list - [ - ("item_id", { Attribute.value = Obj.repr 1 }); - ("order_id", { Attribute.value = Obj.repr 100 }); - ]; - } - in - let db, items, _ = - match - Manipulation.Memory.create_tuple storage db items valid_item - with - | Error _ -> assert false - | Ok x -> x - in - (* Insert item referencing nonexistent order, should fail *) - let invalid_item : Tuple.materialized = - { - relation = "order_items"; - attributes = - Tuple.AttributeMap.of_list - [ - ("item_id", { Attribute.value = Obj.repr 2 }); - ("order_id", { Attribute.value = Obj.repr 999 }); - ]; - } - in - match Manipulation.Memory.create_tuple storage db items invalid_item with - | Error (Manipulation.ConstraintViolation _) -> () - | _ -> assert false) + in + let db, _orders, _ = + match + Manipulation.Memory.create_tuple storage db orders order_tuple + with + | Error _ -> assert false + | Ok x -> x + in + (* Insert item referencing valid order, should succeed *) + let items = + match Manipulation.Memory.get_relation db ~name:"order_items" with + | None -> assert false + | Some r -> r + in + let valid_item : Tuple.materialized = + { + relation = "order_items"; + attributes = + Tuple.AttributeMap.of_list + [ + ("item_id", { Attribute.value = Obj.repr 1 }); + ("order_id", { Attribute.value = Obj.repr 100 }); + ]; + } + in + let db, items, _ = + match Manipulation.Memory.create_tuple storage db items valid_item with + | Error _ -> assert false + | Ok x -> x + in + (* Insert item referencing nonexistent order, should fail *) + let invalid_item : Tuple.materialized = + { + relation = "order_items"; + attributes = + Tuple.AttributeMap.of_list + [ + ("item_id", { Attribute.value = Obj.repr 2 }); + ("order_id", { Attribute.value = Obj.repr 999 }); + ]; + } + in + match Manipulation.Memory.create_tuple storage db items invalid_item with + | Error (Manipulation.ConstraintViolation _) -> () + | _ -> assert false) (* Scenario 3: Self-reference (emp_id != mgr_id via not_equal comparison) *) let%test_unit "constraint scenario: self-reference neq" = with_storage (fun storage -> - let db = - match Manipulation.Memory.create_database storage ~name:"test" with - | Error _ -> assert false - | Ok db -> db - in - let schema = - Schema.empty |> Schema.add "emp_id" "natural" - |> Schema.add "mgr_id" "natural" - in - let db, _rel = - match - Manipulation.Memory.create_relation storage db ~name:"reports_to" - ~schema - with - | Error _ -> assert false - | Ok x -> x - in - (* Register the not_equal comparison relation *) - let db, _ = - match - Manipulation.Memory.create_immutable_relation storage db - ~name:"not_equal" - ~schema: - (Schema.empty |> Schema.add "left" "natural" - |> Schema.add "right" "natural") - ~generator:(fun _ -> Generator.Error "not enumerable") - ~membership_criteria:(fun t -> - match t with - | Tuple.Materialized m -> ( - match - ( Tuple.AttributeMap.find_opt "left" m.attributes, - Tuple.AttributeMap.find_opt "right" m.attributes ) - with - | Some l, Some r -> - (Obj.obj l.Attribute.value : int) - <> (Obj.obj r.Attribute.value : int) + let db = + match Manipulation.Memory.create_database storage ~name:"test" with + | Error _ -> assert false + | Ok db -> db + in + let schema = + Schema.empty + |> Schema.add "emp_id" "natural" + |> Schema.add "mgr_id" "natural" + in + let db, _rel = + match + Manipulation.Memory.create_relation storage db ~name:"reports_to" + ~schema + with + | Error _ -> assert false + | Ok x -> x + in + (* Register the not_equal comparison relation *) + let db, _ = + match + Manipulation.Memory.create_immutable_relation storage db + ~name:"not_equal" + ~schema: + (Schema.empty + |> Schema.add "left" "natural" + |> Schema.add "right" "natural") + ~generator:(fun _ -> Generator.Error "not enumerable") + ~membership_criteria:(fun t -> + match t with + | Tuple.Materialized m -> ( + match + ( Tuple.AttributeMap.find_opt "left" m.attributes, + Tuple.AttributeMap.find_opt "right" m.attributes ) + with + | Some l, Some r -> + (Obj.obj l.Attribute.value : int) + <> (Obj.obj r.Attribute.value : int) + | _ -> false) | _ -> false) - | _ -> false) - ~cardinality:Conventions.Cardinality.AlephZero - with - | Error _ -> assert false - | Ok x -> x - in - (* Constraint: emp_id != mgr_id via not_equal relation *) - let neq_body = - Constraint.neq ~left:(Var "emp_id") ~right:(Var "mgr_id") - in - let db = - match - Manipulation.Memory.register_constraint storage db - ~constraint_name:"no_self_manage" ~relation_name:"reports_to" - ~body:neq_body - with - | Error _ -> assert false - | Ok db -> db - in - let rel = - match Manipulation.Memory.get_relation db ~name:"reports_to" with - | None -> assert false - | Some r -> r - in - (* Insert (emp_id=1, mgr_id=2), should succeed *) - let valid : Tuple.materialized = - { - relation = "reports_to"; - attributes = - Tuple.AttributeMap.of_list - [ - ("emp_id", { Attribute.value = Obj.repr 1 }); - ("mgr_id", { Attribute.value = Obj.repr 2 }); - ]; - } - in - let db, rel, _ = - match Manipulation.Memory.create_tuple storage db rel valid with - | Error _ -> assert false - | Ok x -> x - in - (* Insert (emp_id=3, mgr_id=3): same person, should fail *) - let invalid : Tuple.materialized = - { - relation = "reports_to"; - attributes = - Tuple.AttributeMap.of_list - [ - ("emp_id", { Attribute.value = Obj.repr 3 }); - ("mgr_id", { Attribute.value = Obj.repr 3 }); - ]; - } - in - match Manipulation.Memory.create_tuple storage db rel invalid with - | Error (Manipulation.ConstraintViolation _) -> () - | _ -> assert false) + ~cardinality:Conventions.Cardinality.AlephZero + with + | Error _ -> assert false + | Ok x -> x + in + (* Constraint: emp_id != mgr_id via not_equal relation *) + let neq_body = + Constraint.neq ~left:(Var "emp_id") ~right:(Var "mgr_id") + in + let db = + match + Manipulation.Memory.register_constraint storage db + ~constraint_name:"no_self_manage" ~relation_name:"reports_to" + ~body:neq_body + with + | Error _ -> assert false + | Ok db -> db + in + let rel = + match Manipulation.Memory.get_relation db ~name:"reports_to" with + | None -> assert false + | Some r -> r + in + (* Insert (emp_id=1, mgr_id=2), should succeed *) + let valid : Tuple.materialized = + { + relation = "reports_to"; + attributes = + Tuple.AttributeMap.of_list + [ + ("emp_id", { Attribute.value = Obj.repr 1 }); + ("mgr_id", { Attribute.value = Obj.repr 2 }); + ]; + } + in + let db, rel, _ = + match Manipulation.Memory.create_tuple storage db rel valid with + | Error _ -> assert false + | Ok x -> x + in + (* Insert (emp_id=3, mgr_id=3): same person, should fail *) + let invalid : Tuple.materialized = + { + relation = "reports_to"; + attributes = + Tuple.AttributeMap.of_list + [ + ("emp_id", { Attribute.value = Obj.repr 3 }); + ("mgr_id", { Attribute.value = Obj.repr 3 }); + ]; + } + in + match Manipulation.Memory.create_tuple storage db rel invalid with + | Error (Manipulation.ConstraintViolation _) -> () + | _ -> assert false) (* Scenario 4: Mutual exclusion between open_ticket and closed_ticket *) let%test_unit "constraint scenario: open vs closed ticket" = with_storage (fun storage -> - let db = - match Manipulation.Memory.create_database storage ~name:"test" with - | Error _ -> assert false - | Ok db -> db - in - let schema = Schema.empty |> Schema.add "ticket_id" "natural" in - let db, _ = - match - Manipulation.Memory.create_relation storage db ~name:"open_ticket" - ~schema - with - | Error _ -> assert false - | Ok x -> x - in - let db, _ = - match - Manipulation.Memory.create_relation storage db ~name:"closed_ticket" - ~schema - with - | Error _ -> assert false - | Ok x -> x - in - (* open_ticket must not be in closed_ticket *) - let db = - match - Manipulation.Memory.register_constraint storage db - ~constraint_name:"not_closed" ~relation_name:"open_ticket" - ~body: - (Constraint.Not - { - body = - Constraint.MemberOf - { - target = "closed_ticket"; - binding = - Constraint.BindingMap.singleton "ticket_id" - (Constraint.Var "ticket_id"); - }; - universe = "open_ticket"; - }) - with - | Error _ -> assert false - | Ok db -> db - in - (* Insert ticket 1 as closed *) - let closed = - match Manipulation.Memory.get_relation db ~name:"closed_ticket" with - | None -> assert false - | Some r -> r - in - let t1 : Tuple.materialized = - { - relation = "closed_ticket"; - attributes = - Tuple.AttributeMap.singleton "ticket_id" - { Attribute.value = Obj.repr 1 }; - } - in - let db, _, _ = - match Manipulation.Memory.create_tuple storage db closed t1 with - | Error _ -> assert false - | Ok x -> x - in - (* Try to open same ticket, should fail *) - let open_ = - match Manipulation.Memory.get_relation db ~name:"open_ticket" with - | None -> assert false - | Some r -> r - in - let t1_open : Tuple.materialized = - { - relation = "open_ticket"; - attributes = - Tuple.AttributeMap.singleton "ticket_id" - { Attribute.value = Obj.repr 1 }; - } - in - match Manipulation.Memory.create_tuple storage db open_ t1_open with - | Error (Manipulation.ConstraintViolation _) -> () - | _ -> assert false) + let db = + match Manipulation.Memory.create_database storage ~name:"test" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty |> Schema.add "ticket_id" "natural" in + let db, _ = + match + Manipulation.Memory.create_relation storage db ~name:"open_ticket" + ~schema + with + | Error _ -> assert false + | Ok x -> x + in + let db, _ = + match + Manipulation.Memory.create_relation storage db ~name:"closed_ticket" + ~schema + with + | Error _ -> assert false + | Ok x -> x + in + (* open_ticket must not be in closed_ticket *) + let db = + match + Manipulation.Memory.register_constraint storage db + ~constraint_name:"not_closed" ~relation_name:"open_ticket" + ~body: + (Constraint.Not + { + body = + Constraint.MemberOf + { + target = "closed_ticket"; + binding = + Constraint.BindingMap.singleton "ticket_id" + (Constraint.Var "ticket_id"); + }; + universe = "open_ticket"; + }) + with + | Error _ -> assert false + | Ok db -> db + in + (* Insert ticket 1 as closed *) + let closed = + match Manipulation.Memory.get_relation db ~name:"closed_ticket" with + | None -> assert false + | Some r -> r + in + let t1 : Tuple.materialized = + { + relation = "closed_ticket"; + attributes = + Tuple.AttributeMap.singleton "ticket_id" + { Attribute.value = Obj.repr 1 }; + } + in + let db, _, _ = + match Manipulation.Memory.create_tuple storage db closed t1 with + | Error _ -> assert false + | Ok x -> x + in + (* Try to open same ticket, should fail *) + let open_ = + match Manipulation.Memory.get_relation db ~name:"open_ticket" with + | None -> assert false + | Some r -> r + in + let t1_open : Tuple.materialized = + { + relation = "open_ticket"; + attributes = + Tuple.AttributeMap.singleton "ticket_id" + { Attribute.value = Obj.repr 1 }; + } + in + match Manipulation.Memory.create_tuple storage db open_ t1_open with + | Error (Manipulation.ConstraintViolation _) -> () + | _ -> assert false) (* Scenario 5: Weak entity dependency *) let%test_unit "constraint scenario: weak entity dependency" = with_storage (fun storage -> - let db = - match Manipulation.Memory.create_database storage ~name:"test" with - | Error _ -> assert false - | Ok db -> db - in - let parent_schema = Schema.empty |> Schema.add "parent_id" "natural" in - let db, _ = - match - Manipulation.Memory.create_relation storage db ~name:"parent" - ~schema:parent_schema - with - | Error _ -> assert false - | Ok x -> x - in - let dep_schema = - Schema.empty |> Schema.add "dep_id" "natural" - |> Schema.add "parent_id" "natural" - in - let db, _ = - match - Manipulation.Memory.create_relation storage db ~name:"dependent" - ~schema:dep_schema - with - | Error _ -> assert false - | Ok x -> x - in - (* dependent.parent_id must exist in parent *) - let db = - match - Manipulation.Memory.register_constraint storage db - ~constraint_name:"parent_exists" ~relation_name:"dependent" - ~body: - (Constraint.MemberOf - { - target = "parent"; - binding = - Constraint.BindingMap.singleton "parent_id" - (Constraint.Var "parent_id"); - }) - with - | Error _ -> assert false - | Ok db -> db - in - (* Insert parent *) - let parent = - match Manipulation.Memory.get_relation db ~name:"parent" with - | None -> assert false - | Some r -> r - in - let pt : Tuple.materialized = - { - relation = "parent"; - attributes = - Tuple.AttributeMap.singleton "parent_id" - { Attribute.value = Obj.repr 10 }; - } - in - let db, _, _ = - match Manipulation.Memory.create_tuple storage db parent pt with - | Error _ -> assert false - | Ok x -> x - in - (* Insert dependent with valid parent, should succeed *) - let dep = - match Manipulation.Memory.get_relation db ~name:"dependent" with - | None -> assert false - | Some r -> r - in - let valid_dep : Tuple.materialized = - { - relation = "dependent"; - attributes = - Tuple.AttributeMap.of_list - [ - ("dep_id", { Attribute.value = Obj.repr 1 }); - ("parent_id", { Attribute.value = Obj.repr 10 }); - ]; - } - in - let db, dep, _ = - match - Manipulation.Memory.create_tuple storage db dep valid_dep - with - | Error _ -> assert false - | Ok x -> x - in - (* Insert dependent with nonexistent parent, should fail *) - let invalid_dep : Tuple.materialized = - { - relation = "dependent"; - attributes = - Tuple.AttributeMap.of_list - [ - ("dep_id", { Attribute.value = Obj.repr 2 }); - ("parent_id", { Attribute.value = Obj.repr 999 }); - ]; - } - in - match - Manipulation.Memory.create_tuple storage db dep invalid_dep - with - | Error (Manipulation.ConstraintViolation _) -> () - | _ -> assert false) + let db = + match Manipulation.Memory.create_database storage ~name:"test" with + | Error _ -> assert false + | Ok db -> db + in + let parent_schema = Schema.empty |> Schema.add "parent_id" "natural" in + let db, _ = + match + Manipulation.Memory.create_relation storage db ~name:"parent" + ~schema:parent_schema + with + | Error _ -> assert false + | Ok x -> x + in + let dep_schema = + Schema.empty + |> Schema.add "dep_id" "natural" + |> Schema.add "parent_id" "natural" + in + let db, _ = + match + Manipulation.Memory.create_relation storage db ~name:"dependent" + ~schema:dep_schema + with + | Error _ -> assert false + | Ok x -> x + in + (* dependent.parent_id must exist in parent *) + let db = + match + Manipulation.Memory.register_constraint storage db + ~constraint_name:"parent_exists" ~relation_name:"dependent" + ~body: + (Constraint.MemberOf + { + target = "parent"; + binding = + Constraint.BindingMap.singleton "parent_id" + (Constraint.Var "parent_id"); + }) + with + | Error _ -> assert false + | Ok db -> db + in + (* Insert parent *) + let parent = + match Manipulation.Memory.get_relation db ~name:"parent" with + | None -> assert false + | Some r -> r + in + let pt : Tuple.materialized = + { + relation = "parent"; + attributes = + Tuple.AttributeMap.singleton "parent_id" + { Attribute.value = Obj.repr 10 }; + } + in + let db, _, _ = + match Manipulation.Memory.create_tuple storage db parent pt with + | Error _ -> assert false + | Ok x -> x + in + (* Insert dependent with valid parent, should succeed *) + let dep = + match Manipulation.Memory.get_relation db ~name:"dependent" with + | None -> assert false + | Some r -> r + in + let valid_dep : Tuple.materialized = + { + relation = "dependent"; + attributes = + Tuple.AttributeMap.of_list + [ + ("dep_id", { Attribute.value = Obj.repr 1 }); + ("parent_id", { Attribute.value = Obj.repr 10 }); + ]; + } + in + let db, dep, _ = + match Manipulation.Memory.create_tuple storage db dep valid_dep with + | Error _ -> assert false + | Ok x -> x + in + (* Insert dependent with nonexistent parent, should fail *) + let invalid_dep : Tuple.materialized = + { + relation = "dependent"; + attributes = + Tuple.AttributeMap.of_list + [ + ("dep_id", { Attribute.value = Obj.repr 2 }); + ("parent_id", { Attribute.value = Obj.repr 999 }); + ]; + } + in + match Manipulation.Memory.create_tuple storage db dep invalid_dep with + | Error (Manipulation.ConstraintViolation _) -> () + | _ -> assert false) (* Scenario 6: Algebra propagation, select preserves constraints *) let%test_unit "constraint propagation: select preserves constraints" = with_storage (fun storage -> - let db = - match Manipulation.Memory.create_database storage ~name:"test" with - | Error _ -> assert false - | Ok db -> db - in - let schema = Schema.empty |> Schema.add "x" "natural" in - let db, _rel = - match - Manipulation.Memory.create_relation storage db ~name:"constrained" - ~schema - with - | Error _ -> assert false - | Ok x -> x - in - let db = - match - Manipulation.Memory.register_constraint storage db - ~constraint_name:"c1" ~relation_name:"constrained" - ~body:(Constraint.And []) - with + let db = + match Manipulation.Memory.create_database storage ~name:"test" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty |> Schema.add "x" "natural" in + let db, _rel = + match + Manipulation.Memory.create_relation storage db ~name:"constrained" + ~schema + with + | Error _ -> assert false + | Ok x -> x + in + let db = + match + Manipulation.Memory.register_constraint storage db + ~constraint_name:"c1" ~relation_name:"constrained" + ~body:(Constraint.And []) + with + | Error _ -> assert false + | Ok db -> db + in + let rel = + match Manipulation.Memory.get_relation db ~name:"constrained" with + | None -> assert false + | Some r -> r + in + match Algebra.Memory.select_fn storage (fun _ -> true) rel with | Error _ -> assert false - | Ok db -> db - in - let rel = - match Manipulation.Memory.get_relation db ~name:"constrained" with - | None -> assert false - | Some r -> r - in - match - Algebra.Memory.select_fn storage (fun _ -> true) rel - with - | Error _ -> assert false - | Ok result -> - assert (result.Relation.constraints <> None)) + | Ok result -> assert (result.Relation.constraints <> None)) (* Scenario 7: Algebra propagation, project filters constraints *) let%test_unit "constraint propagation: project filters constraints" = with_storage (fun storage -> - let db = - match Manipulation.Memory.create_database storage ~name:"test" with - | Error _ -> assert false - | Ok db -> db - in - let schema = - Schema.empty |> Schema.add "x" "natural" |> Schema.add "y" "natural" - in - let db, _rel = - match - Manipulation.Memory.create_relation storage db ~name:"xy" ~schema - with + let db = + match Manipulation.Memory.create_database storage ~name:"test" with + | Error _ -> assert false + | Ok db -> db + in + let schema = + Schema.empty |> Schema.add "x" "natural" |> Schema.add "y" "natural" + in + let db, _rel = + match + Manipulation.Memory.create_relation storage db ~name:"xy" ~schema + with + | Error _ -> assert false + | Ok x -> x + in + (* Constraint on x only *) + let c_on_x = + Constraint.MemberOf + { + target = "some_rel"; + binding = + Constraint.BindingMap.singleton "left" (Constraint.Var "x"); + } + in + let db = + match + Manipulation.Memory.register_constraint storage db + ~constraint_name:"x_only" ~relation_name:"xy" ~body:c_on_x + with + | Error _ -> assert false + | Ok db -> db + in + let rel = + match Manipulation.Memory.get_relation db ~name:"xy" with + | None -> assert false + | Some r -> r + in + (* Project to only "x", constraint should survive *) + (match Algebra.Memory.project storage [ "x" ] rel with | Error _ -> assert false - | Ok x -> x - in - (* Constraint on x only *) - let c_on_x = - Constraint.MemberOf - { - target = "some_rel"; - binding = - Constraint.BindingMap.singleton "left" (Constraint.Var "x"); - } - in - let db = - match - Manipulation.Memory.register_constraint storage db - ~constraint_name:"x_only" ~relation_name:"xy" ~body:c_on_x - with + | Ok result -> assert (result.Relation.constraints <> None)); + (* Project to only "y", constraint referencing "x" should be dropped *) + match Algebra.Memory.project storage [ "y" ] rel with | Error _ -> assert false - | Ok db -> db - in - let rel = - match Manipulation.Memory.get_relation db ~name:"xy" with - | None -> assert false - | Some r -> r - in - (* Project to only "x", constraint should survive *) - (match Algebra.Memory.project storage [ "x" ] rel with - | Error _ -> assert false - | Ok result -> assert (result.Relation.constraints <> None)); - (* Project to only "y", constraint referencing "x" should be dropped *) - match Algebra.Memory.project storage [ "y" ] rel with - | Error _ -> assert false - | Ok result -> assert (result.Relation.constraints = None)) + | Ok result -> assert (result.Relation.constraints = None)) (* Parse tests use canonical flat sexp format: (Constructor (field val) ...) *) @@ -2355,37 +2684,46 @@ let%test_unit "ddl: parse ClearRelation" = | Ok stmt -> assert (stmt = Ddl.Ast.ClearRelation "users") let%test_unit "dml: round-trip InsertTuple" = - let src = Dml.Ast.InsertTuple { - relation = "users"; - attributes = [("name", Drl.Ast.Str "Alice"); ("age", Drl.Ast.Int 30)] - } in + let src = + Dml.Ast.InsertTuple + { + relation = "users"; + attributes = [ ("name", Drl.Ast.Str "Alice"); ("age", Drl.Ast.Int 30) ]; + } + in match Dml.Parser.of_string (Dml.Parser.to_string src) with | Error _ -> assert false | Ok parsed -> assert (parsed = src) let%test_unit "ddl: round-trip CreateRelation" = - let src = Ddl.Ast.CreateRelation { - name = "users"; - schema = [("name", "string"); ("age", "natural")] - } in + let src = + Ddl.Ast.CreateRelation + { name = "users"; schema = [ ("name", "string"); ("age", "natural") ] } + in match Ddl.Parser.of_string (Ddl.Parser.to_string src) with | Error _ -> assert false | Ok parsed -> assert (parsed = src) let%test_unit "dml: round-trip InsertTuples" = - let src = Dml.Ast.InsertTuples { - relation = "users"; - tuples = [ - [("name", Drl.Ast.Str "Alice"); ("age", Drl.Ast.Int 30)]; - [("name", Drl.Ast.Str "Bob"); ("age", Drl.Ast.Int 25)]; - ] - } in + let src = + Dml.Ast.InsertTuples + { + relation = "users"; + tuples = + [ + [ ("name", Drl.Ast.Str "Alice"); ("age", Drl.Ast.Int 30) ]; + [ ("name", Drl.Ast.Str "Bob"); ("age", Drl.Ast.Int 25) ]; + ]; + } + in match Dml.Parser.of_string (Dml.Parser.to_string src) with | Error _ -> assert false | Ok parsed -> assert (parsed = src) let%test_unit "ddl: round-trip RegisterDomain" = - let src = Ddl.Ast.RegisterDomain { name = "money"; cardinality = Ddl.Ast.AlephZero } in + let src = + Ddl.Ast.RegisterDomain { name = "money"; cardinality = Ddl.Ast.AlephZero } + in match Ddl.Parser.of_string (Ddl.Parser.to_string src) with | Error _ -> assert false | Ok parsed -> assert (parsed = src) @@ -2394,550 +2732,867 @@ let%test_unit "ddl: round-trip RegisterDomain" = let%test_unit "ddl: execute CreateDatabase" = with_storage (fun storage -> - let db = Management.Database.empty ~name:"" in - let stmt = Ddl.Ast.CreateDatabase "shop" in - match Ddl.Executor.Memory.execute storage db stmt with - | Error _ -> assert false - | Ok (db, _msg) -> assert (db.name = "shop")) + let db = Management.Database.empty ~name:"" in + let stmt = Ddl.Ast.CreateDatabase "shop" in + match Ddl.Executor.Memory.execute storage db stmt with + | Error _ -> assert false + | Ok (db, _msg) -> assert (db.name = "shop")) let%test_unit "ddl: execute CreateRelation" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"shop" with - | Error _ -> assert false | Ok db -> db - in - let stmt = Ddl.Ast.CreateRelation { name = "users"; schema = [("name", "string"); ("age", "natural")] } in - match Ddl.Executor.Memory.execute storage db stmt with - | Error _ -> assert false - | Ok (db, _msg) -> assert (Management.Database.has_relation db "users")) + let db = + match Manipulation.Memory.create_database storage ~name:"shop" with + | Error _ -> assert false + | Ok db -> db + in + let stmt = + Ddl.Ast.CreateRelation + { + name = "users"; + schema = [ ("name", "string"); ("age", "natural") ]; + } + in + match Ddl.Executor.Memory.execute storage db stmt with + | Error _ -> assert false + | Ok (db, _msg) -> assert (Management.Database.has_relation db "users")) let%test_unit "dml: execute InsertTuple" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"shop" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty |> Schema.add "name" "string" in - let db = match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with - | Error _ -> assert false | Ok (db, _) -> db - in - let stmt = Dml.Ast.InsertTuple { relation = "users"; attributes = [("name", Drl.Ast.Str "Alice")] } in - match Dml.Executor.Memory.execute storage db stmt with - | Error _ -> assert false - | Ok db -> - let rel = match Management.Database.get_relation db "users" with - | None -> assert false | Some r -> r + let db = + match Manipulation.Memory.create_database storage ~name:"shop" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty |> Schema.add "name" "string" in + let db = + match + Manipulation.Memory.create_relation storage db ~name:"users" ~schema + with + | Error _ -> assert false + | Ok (db, _) -> db in - assert (Manipulation.Memory.tuple_count rel = 1)) + let stmt = + Dml.Ast.InsertTuple + { relation = "users"; attributes = [ ("name", Drl.Ast.Str "Alice") ] } + in + match Dml.Executor.Memory.execute storage db stmt with + | Error _ -> assert false + | Ok db -> + let rel = + match Management.Database.get_relation db "users" with + | None -> assert false + | Some r -> r + in + assert (Manipulation.Memory.tuple_count rel = 1)) let%test_unit "dml: execute InsertTuples" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"shop" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty |> Schema.add "name" "string" in - let db = match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with - | Error _ -> assert false | Ok (db, _) -> db - in - let stmt = Dml.Ast.InsertTuples { - relation = "users"; - tuples = [[("name", Drl.Ast.Str "Alice")]; [("name", Drl.Ast.Str "Bob")]] - } in - match Dml.Executor.Memory.execute storage db stmt with - | Error _ -> assert false - | Ok db -> - let rel = match Management.Database.get_relation db "users" with - | None -> assert false | Some r -> r + let db = + match Manipulation.Memory.create_database storage ~name:"shop" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty |> Schema.add "name" "string" in + let db = + match + Manipulation.Memory.create_relation storage db ~name:"users" ~schema + with + | Error _ -> assert false + | Ok (db, _) -> db + in + let stmt = + Dml.Ast.InsertTuples + { + relation = "users"; + tuples = + [ + [ ("name", Drl.Ast.Str "Alice") ]; + [ ("name", Drl.Ast.Str "Bob") ]; + ]; + } in - assert (Manipulation.Memory.tuple_count rel = 2)) + match Dml.Executor.Memory.execute storage db stmt with + | Error _ -> assert false + | Ok db -> + let rel = + match Management.Database.get_relation db "users" with + | None -> assert false + | Some r -> r + in + assert (Manipulation.Memory.tuple_count rel = 2)) let%test_unit "dml: execute DeleteTuple" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"shop" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty |> Schema.add "name" "string" in - let db = match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with - | Error _ -> assert false | Ok (db, _) -> db - in - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "users"; attributes = [("name", Drl.Ast.Str "Alice")] }) with - | Error _ -> assert false | Ok db -> db - in - let stmt = Dml.Ast.DeleteTuple { relation = "users"; attributes = [("name", Drl.Ast.Str "Alice")] } in - match Dml.Executor.Memory.execute storage db stmt with - | Error _ -> assert false - | Ok db -> - let rel = match Management.Database.get_relation db "users" with - | None -> assert false | Some r -> r + let db = + match Manipulation.Memory.create_database storage ~name:"shop" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty |> Schema.add "name" "string" in + let db = + match + Manipulation.Memory.create_relation storage db ~name:"users" ~schema + with + | Error _ -> assert false + | Ok (db, _) -> db + in + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "users"; + attributes = [ ("name", Drl.Ast.Str "Alice") ]; + }) + with + | Error _ -> assert false + | Ok db -> db + in + let stmt = + Dml.Ast.DeleteTuple + { relation = "users"; attributes = [ ("name", Drl.Ast.Str "Alice") ] } in - assert (Manipulation.Memory.tuple_count rel = 0)) + match Dml.Executor.Memory.execute storage db stmt with + | Error _ -> assert false + | Ok db -> + let rel = + match Management.Database.get_relation db "users" with + | None -> assert false + | Some r -> r + in + assert (Manipulation.Memory.tuple_count rel = 0)) let%test_unit "ddl: execute RetractRelation" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"shop" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty in - let db = match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with - | Error _ -> assert false | Ok (db, _) -> db - in - match Ddl.Executor.Memory.execute storage db (Ddl.Ast.RetractRelation "users") with - | Error _ -> assert false - | Ok (db, _msg) -> assert (not (Management.Database.has_relation db "users"))) + let db = + match Manipulation.Memory.create_database storage ~name:"shop" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty in + let db = + match + Manipulation.Memory.create_relation storage db ~name:"users" ~schema + with + | Error _ -> assert false + | Ok (db, _) -> db + in + match + Ddl.Executor.Memory.execute storage db (Ddl.Ast.RetractRelation "users") + with + | Error _ -> assert false + | Ok (db, _msg) -> + assert (not (Management.Database.has_relation db "users"))) let%test_unit "ddl: execute ClearRelation" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"shop" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty |> Schema.add "name" "string" in - let db = match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with - | Error _ -> assert false | Ok (db, _) -> db - in - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuples { relation = "users"; - tuples = [[("name", Drl.Ast.Str "Alice")]; [("name", Drl.Ast.Str "Bob")]] }) with - | Error _ -> assert false | Ok db -> db - in - match Ddl.Executor.Memory.execute storage db (Ddl.Ast.ClearRelation "users") with - | Error _ -> assert false - | Ok (db, _msg) -> - let rel = match Management.Database.get_relation db "users" with - | None -> assert false | Some r -> r + let db = + match Manipulation.Memory.create_database storage ~name:"shop" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty |> Schema.add "name" "string" in + let db = + match + Manipulation.Memory.create_relation storage db ~name:"users" ~schema + with + | Error _ -> assert false + | Ok (db, _) -> db + in + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuples + { + relation = "users"; + tuples = + [ + [ ("name", Drl.Ast.Str "Alice") ]; + [ ("name", Drl.Ast.Str "Bob") ]; + ]; + }) + with + | Error _ -> assert false + | Ok db -> db in - assert (Manipulation.Memory.tuple_count rel = 0)) + match + Ddl.Executor.Memory.execute storage db (Ddl.Ast.ClearRelation "users") + with + | Error _ -> assert false + | Ok (db, _msg) -> + let rel = + match Management.Database.get_relation db "users" with + | None -> assert false + | Some r -> r + in + assert (Manipulation.Memory.tuple_count rel = 0)) let%test_unit "ddl: execute RegisterDomain" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"shop" with - | Error _ -> assert false | Ok db -> db - in - let stmt = Ddl.Ast.RegisterDomain { name = "money"; cardinality = Ddl.Ast.AlephZero } in - match Ddl.Executor.Memory.execute storage db stmt with - | Error _ -> assert false - | Ok (db, _msg) -> assert (Management.Database.has_domain db "money")) + let db = + match Manipulation.Memory.create_database storage ~name:"shop" with + | Error _ -> assert false + | Ok db -> db + in + let stmt = + Ddl.Ast.RegisterDomain + { name = "money"; cardinality = Ddl.Ast.AlephZero } + in + match Ddl.Executor.Memory.execute storage db stmt with + | Error _ -> assert false + | Ok (db, _msg) -> assert (Management.Database.has_domain db "money")) let%test_unit "dml: insert into nonexistent relation returns error" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"shop" with - | Error _ -> assert false | Ok db -> db - in - let stmt = Dml.Ast.InsertTuple { relation = "ghost"; attributes = [("x", Drl.Ast.Int 1)] } in - match Dml.Executor.Memory.execute storage db stmt with - | Error (Dml.Executor.Memory.RelationNotFound "ghost") -> () - | _ -> assert false) + let db = + match Manipulation.Memory.create_database storage ~name:"shop" with + | Error _ -> assert false + | Ok db -> db + in + let stmt = + Dml.Ast.InsertTuple + { relation = "ghost"; attributes = [ ("x", Drl.Ast.Int 1) ] } + in + match Dml.Executor.Memory.execute storage db stmt with + | Error (Dml.Executor.Memory.RelationNotFound "ghost") -> () + | _ -> assert false) let%test_unit "dcl: round-trip RegisterConstraint MemberOf" = - let src = Icl.Ast.RegisterConstraint { - constraint_name = "fk_order"; - relation_name = "order_items"; - body = Icl.Ast.MemberOf { target = "orders"; binding = [("order_id", Icl.Ast.Var "order_id")] } - } in + let src = + Icl.Ast.RegisterConstraint + { + constraint_name = "fk_order"; + relation_name = "order_items"; + body = + Icl.Ast.MemberOf + { + target = "orders"; + binding = [ ("order_id", Icl.Ast.Var "order_id") ]; + }; + } + in match Icl.Parser.of_string (Icl.Parser.to_string src) with | Error _ -> assert false | Ok parsed -> assert (parsed = src) let%test_unit "dcl: round-trip And constraint" = - let src = Icl.Ast.RegisterConstraint { - constraint_name = "valid_range"; - relation_name = "scores"; - body = Icl.Ast.And [ - Icl.Ast.MemberOf { target = "ge_zero"; - binding = [("left", Icl.Ast.Var "score"); ("right", Icl.Ast.Const (Drl.Ast.Int 0))] }; - Icl.Ast.MemberOf { target = "le_hundred"; - binding = [("left", Icl.Ast.Var "score"); ("right", Icl.Ast.Const (Drl.Ast.Int 100))] }; - ] - } in + let src = + Icl.Ast.RegisterConstraint + { + constraint_name = "valid_range"; + relation_name = "scores"; + body = + Icl.Ast.And + [ + Icl.Ast.MemberOf + { + target = "ge_zero"; + binding = + [ + ("left", Icl.Ast.Var "score"); + ("right", Icl.Ast.Const (Drl.Ast.Int 0)); + ]; + }; + Icl.Ast.MemberOf + { + target = "le_hundred"; + binding = + [ + ("left", Icl.Ast.Var "score"); + ("right", Icl.Ast.Const (Drl.Ast.Int 100)); + ]; + }; + ]; + } + in match Icl.Parser.of_string (Icl.Parser.to_string src) with | Error _ -> assert false | Ok parsed -> assert (parsed = src) let%test_unit "dcl: round-trip Not constraint" = - let src = Icl.Ast.RegisterConstraint { - constraint_name = "not_closed"; - relation_name = "open_ticket"; - body = Icl.Ast.Not { - body = Icl.Ast.MemberOf { target = "closed_ticket"; - binding = [("ticket_id", Icl.Ast.Var "ticket_id")] }; - universe = "open_ticket" - } - } in + let src = + Icl.Ast.RegisterConstraint + { + constraint_name = "not_closed"; + relation_name = "open_ticket"; + body = + Icl.Ast.Not + { + body = + Icl.Ast.MemberOf + { + target = "closed_ticket"; + binding = [ ("ticket_id", Icl.Ast.Var "ticket_id") ]; + }; + universe = "open_ticket"; + }; + } + in match Icl.Parser.of_string (Icl.Parser.to_string src) with | Error _ -> assert false | Ok parsed -> assert (parsed = src) let%test_unit "dcl: execute RegisterConstraint attaches constraint" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"shop" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty |> Schema.add "order_id" "natural" in - let db = match Manipulation.Memory.create_relation storage db ~name:"order_items" ~schema with - | Error _ -> assert false | Ok (db, _) -> db - in - let stmt = Icl.Ast.RegisterConstraint { - constraint_name = "fk_order"; - relation_name = "order_items"; - body = Icl.Ast.MemberOf { target = "orders"; binding = [("order_id", Icl.Ast.Var "order_id")] } - } in - match Icl.Executor.Memory.execute storage db stmt with - | Error _ -> assert false - | Ok (db, _) -> - let rel = match Management.Database.get_relation db "order_items" with - | None -> assert false | Some r -> r + let db = + match Manipulation.Memory.create_database storage ~name:"shop" with + | Error _ -> assert false + | Ok db -> db in - assert (rel.Relation.constraints <> None)) + let schema = Schema.empty |> Schema.add "order_id" "natural" in + let db = + match + Manipulation.Memory.create_relation storage db ~name:"order_items" + ~schema + with + | Error _ -> assert false + | Ok (db, _) -> db + in + let stmt = + Icl.Ast.RegisterConstraint + { + constraint_name = "fk_order"; + relation_name = "order_items"; + body = + Icl.Ast.MemberOf + { + target = "orders"; + binding = [ ("order_id", Icl.Ast.Var "order_id") ]; + }; + } + in + match Icl.Executor.Memory.execute storage db stmt with + | Error _ -> assert false + | Ok (db, _) -> + let rel = + match Management.Database.get_relation db "order_items" with + | None -> assert false + | Some r -> r + in + assert (rel.Relation.constraints <> None)) let%test_unit "dcl: FK constraint enforced on insert" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"shop" with - | Error _ -> assert false | Ok db -> db - in - let db = match Manipulation.Memory.create_relation storage db ~name:"orders" - ~schema:(Schema.empty |> Schema.add "id" "natural") with - | Error _ -> assert false | Ok (db, _) -> db - in - (* Insert a valid order *) - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "orders"; attributes = [("id", Drl.Ast.Int 1)] }) with - | Error _ -> assert false | Ok db -> db - in - let db = match Manipulation.Memory.create_relation storage db ~name:"order_items" - ~schema:(Schema.empty |> Schema.add "order_id" "natural") with - | Error _ -> assert false | Ok (db, _) -> db - in - (* Register FK: order_id in order_items must match id in orders *) - let db = match Icl.Executor.Memory.execute storage db - (Icl.Ast.RegisterConstraint { - constraint_name = "fk_order"; - relation_name = "order_items"; - body = Icl.Ast.MemberOf { target = "orders"; binding = [("id", Icl.Ast.Var "order_id")] } - }) with - | Error _ -> assert false | Ok (db, _) -> db - in - (* Valid insert: order_id=1 exists in orders *) - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "order_items"; attributes = [("order_id", Drl.Ast.Int 1)] }) with - | Error _ -> assert false | Ok db -> db - in - let rel = match Management.Database.get_relation db "order_items" with - | None -> assert false | Some r -> r - in - assert (Manipulation.Memory.tuple_count rel = 1); - (* Invalid insert: order_id=99 does not exist in orders *) - match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "order_items"; attributes = [("order_id", Drl.Ast.Int 99)] }) with - | Error (Dml.Executor.Memory.ManipulationError (Manipulation.ConstraintViolation _)) -> () - | _ -> assert false) + let db = + match Manipulation.Memory.create_database storage ~name:"shop" with + | Error _ -> assert false + | Ok db -> db + in + let db = + match + Manipulation.Memory.create_relation storage db ~name:"orders" + ~schema:(Schema.empty |> Schema.add "id" "natural") + with + | Error _ -> assert false + | Ok (db, _) -> db + in + (* Insert a valid order *) + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { relation = "orders"; attributes = [ ("id", Drl.Ast.Int 1) ] }) + with + | Error _ -> assert false + | Ok db -> db + in + let db = + match + Manipulation.Memory.create_relation storage db ~name:"order_items" + ~schema:(Schema.empty |> Schema.add "order_id" "natural") + with + | Error _ -> assert false + | Ok (db, _) -> db + in + (* Register FK: order_id in order_items must match id in orders *) + let db = + match + Icl.Executor.Memory.execute storage db + (Icl.Ast.RegisterConstraint + { + constraint_name = "fk_order"; + relation_name = "order_items"; + body = + Icl.Ast.MemberOf + { + target = "orders"; + binding = [ ("id", Icl.Ast.Var "order_id") ]; + }; + }) + with + | Error _ -> assert false + | Ok (db, _) -> db + in + (* Valid insert: order_id=1 exists in orders *) + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "order_items"; + attributes = [ ("order_id", Drl.Ast.Int 1) ]; + }) + with + | Error _ -> assert false + | Ok db -> db + in + let rel = + match Management.Database.get_relation db "order_items" with + | None -> assert false + | Some r -> r + in + assert (Manipulation.Memory.tuple_count rel = 1); + (* Invalid insert: order_id=99 does not exist in orders *) + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "order_items"; + attributes = [ ("order_id", Drl.Ast.Int 99) ]; + }) + with + | Error + (Dml.Executor.Memory.ManipulationError + (Manipulation.ConstraintViolation _)) -> + () + | _ -> assert false) -module BranchMemory = Management.Branch.Make(Management.Physical.Memory) +module BranchMemory = Management.Branch.Make (Management.Physical.Memory) let%test_unit "branch: create and get_tip" = with_storage (fun storage -> - let tip = "deadbeef" in - (match BranchMemory.create storage ~name:"main" ~tip with - | Error _ -> assert false - | Ok () -> ()); - match BranchMemory.get_tip storage "main" with - | Error _ -> assert false - | Ok None -> assert false - | Ok (Some t) -> assert (t = tip)) + let tip = "deadbeef" in + (match BranchMemory.create storage ~name:"main" ~tip with + | Error _ -> assert false + | Ok () -> ()); + match BranchMemory.get_tip storage "main" with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some t) -> assert (t = tip)) let%test_unit "branch: get_tip returns None for unknown branch" = with_storage (fun storage -> - match BranchMemory.get_tip storage "nonexistent" with - | Error _ -> assert false - | Ok None -> () - | Ok (Some _) -> assert false) + match BranchMemory.get_tip storage "nonexistent" with + | Error _ -> assert false + | Ok None -> () + | Ok (Some _) -> assert false) let%test_unit "branch: checkout and get_head" = with_storage (fun storage -> - (match BranchMemory.create storage ~name:"main" ~tip:"abc" with - | Error _ -> assert false | Ok () -> ()); - (match BranchMemory.checkout storage "main" with - | Error _ -> assert false | Ok () -> ()); - match BranchMemory.get_head storage with - | Error _ -> assert false - | Ok None -> assert false - | Ok (Some h) -> assert (h = "main")) + (match BranchMemory.create storage ~name:"main" ~tip:"abc" with + | Error _ -> assert false + | Ok () -> ()); + (match BranchMemory.checkout storage "main" with + | Error _ -> assert false + | Ok () -> ()); + match BranchMemory.get_head storage with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some h) -> assert (h = "main")) let%test_unit "branch: get_head returns None when not set" = with_storage (fun storage -> - match BranchMemory.get_head storage with - | Error _ -> assert false - | Ok None -> () - | Ok (Some _) -> assert false) + match BranchMemory.get_head storage with + | Error _ -> assert false + | Ok None -> () + | Ok (Some _) -> assert false) let%test_unit "branch: update_tip advances the branch" = with_storage (fun storage -> - (match BranchMemory.create storage ~name:"main" ~tip:"v1" with - | Error _ -> assert false | Ok () -> ()); - (match BranchMemory.update_tip storage ~name:"main" ~tip:"v2" with - | Error _ -> assert false | Ok () -> ()); - match BranchMemory.get_tip storage "main" with - | Error _ -> assert false - | Ok None -> assert false - | Ok (Some t) -> assert (t = "v2")) + (match BranchMemory.create storage ~name:"main" ~tip:"v1" with + | Error _ -> assert false + | Ok () -> ()); + (match BranchMemory.update_tip storage ~name:"main" ~tip:"v2" with + | Error _ -> assert false + | Ok () -> ()); + match BranchMemory.get_tip storage "main" with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some t) -> assert (t = "v2")) let%test_unit "branch: update_tip fails on unknown branch" = with_storage (fun storage -> - match BranchMemory.update_tip storage ~name:"ghost" ~tip:"v1" with - | Error _ -> () - | Ok () -> assert false) + match BranchMemory.update_tip storage ~name:"ghost" ~tip:"v1" with + | Error _ -> () + | Ok () -> assert false) let%test_unit "branch: multiple branches are independent" = with_storage (fun storage -> - (match BranchMemory.create storage ~name:"main" ~tip:"hash-main" with - | Error _ -> assert false | Ok () -> ()); - (match BranchMemory.create storage ~name:"feature" ~tip:"hash-feature" with - | Error _ -> assert false | Ok () -> ()); - let main_tip = match BranchMemory.get_tip storage "main" with - | Ok (Some t) -> t | _ -> assert false - in - let feat_tip = match BranchMemory.get_tip storage "feature" with - | Ok (Some t) -> t | _ -> assert false - in - assert (main_tip = "hash-main"); - assert (feat_tip = "hash-feature"); - assert (main_tip <> feat_tip)) + (match BranchMemory.create storage ~name:"main" ~tip:"hash-main" with + | Error _ -> assert false + | Ok () -> ()); + (match + BranchMemory.create storage ~name:"feature" ~tip:"hash-feature" + with + | Error _ -> assert false + | Ok () -> ()); + let main_tip = + match BranchMemory.get_tip storage "main" with + | Ok (Some t) -> t + | _ -> assert false + in + let feat_tip = + match BranchMemory.get_tip storage "feature" with + | Ok (Some t) -> t + | _ -> assert false + in + assert (main_tip = "hash-main"); + assert (feat_tip = "hash-feature"); + assert (main_tip <> feat_tip)) let%test_unit "diff: identical databases produce empty diff" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"db" with - | Error _ -> assert false | Ok db -> db - in - let diffs = Management.Diff.diff ~ancestor:db ~target:db in - assert (diffs = [])) + let db = + match Manipulation.Memory.create_database storage ~name:"db" with + | Error _ -> assert false + | Ok db -> db + in + let diffs = Management.Diff.diff ~ancestor:db ~target:db in + assert (diffs = [])) let%test_unit "diff: added relation detected" = with_storage (fun storage -> - let ancestor = match Manipulation.Memory.create_database storage ~name:"db" with - | Error _ -> assert false | Ok db -> db - in - let schema = Schema.empty |> Schema.add "x" "natural" in - let target, _ = match Manipulation.Memory.create_relation storage ancestor - ~name:"new_rel" ~schema with - | Error _ -> assert false | Ok p -> p - in - let diffs = Management.Diff.diff ~ancestor ~target in - let added = List.filter_map (function - | Management.Diff.RelationAdded r -> Some r - | _ -> None) diffs - in - assert (List.exists (fun r -> r.Relation.name = "new_rel") added)) + let ancestor = + match Manipulation.Memory.create_database storage ~name:"db" with + | Error _ -> assert false + | Ok db -> db + in + let schema = Schema.empty |> Schema.add "x" "natural" in + let target, _ = + match + Manipulation.Memory.create_relation storage ancestor ~name:"new_rel" + ~schema + with + | Error _ -> assert false + | Ok p -> p + in + let diffs = Management.Diff.diff ~ancestor ~target in + let added = + List.filter_map + (function Management.Diff.RelationAdded r -> Some r | _ -> None) + diffs + in + assert (List.exists (fun r -> r.Relation.name = "new_rel") added)) let%test_unit "diff: removed relation detected" = with_storage (fun storage -> - let schema = Schema.empty |> Schema.add "x" "natural" in - let ancestor = match Manipulation.Memory.create_database storage ~name:"db" with - | Error _ -> assert false | Ok db -> db - in - let ancestor, _ = match Manipulation.Memory.create_relation storage ancestor - ~name:"gone" ~schema with - | Error _ -> assert false | Ok p -> p - in - let target = match Manipulation.Memory.retract_relation storage ancestor ~name:"gone" with - | Error _ -> assert false | Ok db -> db - in - let diffs = Management.Diff.diff ~ancestor ~target in - let removed = List.filter_map (function - | Management.Diff.RelationRemoved n -> Some n - | _ -> None) diffs - in - assert (List.mem "gone" removed)) + let schema = Schema.empty |> Schema.add "x" "natural" in + let ancestor = + match Manipulation.Memory.create_database storage ~name:"db" with + | Error _ -> assert false + | Ok db -> db + in + let ancestor, _ = + match + Manipulation.Memory.create_relation storage ancestor ~name:"gone" + ~schema + with + | Error _ -> assert false + | Ok p -> p + in + let target = + match + Manipulation.Memory.retract_relation storage ancestor ~name:"gone" + with + | Error _ -> assert false + | Ok db -> db + in + let diffs = Management.Diff.diff ~ancestor ~target in + let removed = + List.filter_map + (function Management.Diff.RelationRemoved n -> Some n | _ -> None) + diffs + in + assert (List.mem "gone" removed)) let%test_unit "diff: modified relation detected with added tuple" = with_storage (fun storage -> - let schema = Schema.empty |> Schema.add "val" "natural" in - let ancestor = match Manipulation.Memory.create_database storage ~name:"db" with - | Error _ -> assert false | Ok db -> db - in - let ancestor, _ = match Manipulation.Memory.create_relation storage ancestor - ~name:"r" ~schema with - | Error _ -> assert false | Ok p -> p - in - let rel = Option.get (Management.Database.get_relation ancestor "r") in - let t : Tuple.materialized = { - Tuple.relation = "r"; - attributes = Tuple.AttributeMap.singleton "val" { Attribute.value = Obj.repr 42 }; - } in - let (target, _, _) = match Manipulation.Memory.create_tuple storage ancestor rel t with - | Error _ -> assert false | Ok p -> p - in - let diffs = Management.Diff.diff ~ancestor ~target in - assert (List.length diffs = 1); - match diffs with - | [ Management.Diff.RelationModified { name; added_tuples; removed_tuples; _ } ] -> - assert (name = "r"); - assert (List.length added_tuples = 1); - assert (removed_tuples = []) - | _ -> assert false) - -module MergeMemory = Management.Merge.Make - (Management.Physical.Memory) - (Manipulation.Memory) + let schema = Schema.empty |> Schema.add "val" "natural" in + let ancestor = + match Manipulation.Memory.create_database storage ~name:"db" with + | Error _ -> assert false + | Ok db -> db + in + let ancestor, _ = + match + Manipulation.Memory.create_relation storage ancestor ~name:"r" ~schema + with + | Error _ -> assert false + | Ok p -> p + in + let rel = Option.get (Management.Database.get_relation ancestor "r") in + let t : Tuple.materialized = + { + Tuple.relation = "r"; + attributes = + Tuple.AttributeMap.singleton "val" { Attribute.value = Obj.repr 42 }; + } + in + let target, _, _ = + match Manipulation.Memory.create_tuple storage ancestor rel t with + | Error _ -> assert false + | Ok p -> p + in + let diffs = Management.Diff.diff ~ancestor ~target in + assert (List.length diffs = 1); + match diffs with + | [ + Management.Diff.RelationModified + { name; added_tuples; removed_tuples; _ }; + ] -> + assert (name = "r"); + assert (List.length added_tuples = 1); + assert (removed_tuples = []) + | _ -> assert false) + +module MergeMemory = + Management.Merge.Make (Management.Physical.Memory) (Manipulation.Memory) let%test_unit "merge: fast-forward when only one side changed" = with_storage (fun storage -> - let schema = Schema.empty |> Schema.add "val" "natural" in - let base_db = match Manipulation.Memory.create_database storage ~name:"db" with - | Error _ -> assert false | Ok db -> db - in - let base_db, _ = match Manipulation.Memory.create_relation storage base_db - ~name:"r" ~schema with - | Error _ -> assert false | Ok p -> p - in - (match Manipulation.Memory.store_database storage base_db with - | Error _ -> assert false | Ok () -> ()); - let rel = Option.get (Management.Database.get_relation base_db "r") in - let t1 : Tuple.materialized = { - Tuple.relation = "r"; - attributes = Tuple.AttributeMap.singleton "val" { Attribute.value = Obj.repr 1 }; - } in - let (left_db, _, _) = match Manipulation.Memory.create_tuple storage base_db rel t1 with - | Error _ -> assert false | Ok p -> p - in - (match Manipulation.Memory.store_database storage left_db with - | Error _ -> assert false | Ok () -> ()); - match MergeMemory.merge ~storage ~strategy:Management.Merge.PreferLeft - ~left_tip:left_db.Management.Database.hash - ~right_tip:base_db.Management.Database.hash with - | Error _ -> assert false - | Ok (Management.Merge.Failed _) -> assert false - | Ok (Management.Merge.Clean merged) -> - let merged_rel = Option.get (Management.Database.get_relation merged "r") in - assert (Manipulation.Memory.tuple_count merged_rel = 1)) + let schema = Schema.empty |> Schema.add "val" "natural" in + let base_db = + match Manipulation.Memory.create_database storage ~name:"db" with + | Error _ -> assert false + | Ok db -> db + in + let base_db, _ = + match + Manipulation.Memory.create_relation storage base_db ~name:"r" ~schema + with + | Error _ -> assert false + | Ok p -> p + in + (match Manipulation.Memory.store_database storage base_db with + | Error _ -> assert false + | Ok () -> ()); + let rel = Option.get (Management.Database.get_relation base_db "r") in + let t1 : Tuple.materialized = + { + Tuple.relation = "r"; + attributes = + Tuple.AttributeMap.singleton "val" { Attribute.value = Obj.repr 1 }; + } + in + let left_db, _, _ = + match Manipulation.Memory.create_tuple storage base_db rel t1 with + | Error _ -> assert false + | Ok p -> p + in + (match Manipulation.Memory.store_database storage left_db with + | Error _ -> assert false + | Ok () -> ()); + match + MergeMemory.merge ~storage ~strategy:Management.Merge.PreferLeft + ~left_tip:left_db.Management.Database.hash + ~right_tip:base_db.Management.Database.hash + with + | Error _ -> assert false + | Ok (Management.Merge.Failed _) -> assert false + | Ok (Management.Merge.Clean merged) -> + let merged_rel = + Option.get (Management.Database.get_relation merged "r") + in + assert (Manipulation.Memory.tuple_count merged_rel = 1)) let%test_unit "merge: independent tuple additions produce union" = with_storage (fun storage -> - let schema = Schema.empty |> Schema.add "val" "natural" in - let base_db = match Manipulation.Memory.create_database storage ~name:"db" with - | Error _ -> assert false | Ok db -> db - in - let base_db, _ = match Manipulation.Memory.create_relation storage base_db - ~name:"r" ~schema with - | Error _ -> assert false | Ok p -> p - in - (match Manipulation.Memory.store_database storage base_db with - | Error _ -> assert false | Ok () -> ()); - let rel = Option.get (Management.Database.get_relation base_db "r") in - let t_left : Tuple.materialized = { - Tuple.relation = "r"; - attributes = Tuple.AttributeMap.singleton "val" { Attribute.value = Obj.repr 10 }; - } in - let (left_db, _, _) = match Manipulation.Memory.create_tuple storage base_db rel t_left with - | Error _ -> assert false | Ok p -> p - in - (match Manipulation.Memory.store_database storage left_db with - | Error _ -> assert false | Ok () -> ()); - let t_right : Tuple.materialized = { - Tuple.relation = "r"; - attributes = Tuple.AttributeMap.singleton "val" { Attribute.value = Obj.repr 20 }; - } in - let (right_db, _, _) = match Manipulation.Memory.create_tuple storage base_db rel t_right with - | Error _ -> assert false | Ok p -> p - in - (match Manipulation.Memory.store_database storage right_db with - | Error _ -> assert false | Ok () -> ()); - match MergeMemory.merge ~storage ~strategy:Management.Merge.PreferLeft - ~left_tip:left_db.Management.Database.hash - ~right_tip:right_db.Management.Database.hash with - | Error _ -> assert false - | Ok (Management.Merge.Failed _) -> assert false - | Ok (Management.Merge.Clean merged) -> - let merged_rel = Option.get (Management.Database.get_relation merged "r") in - assert (Manipulation.Memory.tuple_count merged_rel = 2)) + let schema = Schema.empty |> Schema.add "val" "natural" in + let base_db = + match Manipulation.Memory.create_database storage ~name:"db" with + | Error _ -> assert false + | Ok db -> db + in + let base_db, _ = + match + Manipulation.Memory.create_relation storage base_db ~name:"r" ~schema + with + | Error _ -> assert false + | Ok p -> p + in + (match Manipulation.Memory.store_database storage base_db with + | Error _ -> assert false + | Ok () -> ()); + let rel = Option.get (Management.Database.get_relation base_db "r") in + let t_left : Tuple.materialized = + { + Tuple.relation = "r"; + attributes = + Tuple.AttributeMap.singleton "val" { Attribute.value = Obj.repr 10 }; + } + in + let left_db, _, _ = + match Manipulation.Memory.create_tuple storage base_db rel t_left with + | Error _ -> assert false + | Ok p -> p + in + (match Manipulation.Memory.store_database storage left_db with + | Error _ -> assert false + | Ok () -> ()); + let t_right : Tuple.materialized = + { + Tuple.relation = "r"; + attributes = + Tuple.AttributeMap.singleton "val" { Attribute.value = Obj.repr 20 }; + } + in + let right_db, _, _ = + match Manipulation.Memory.create_tuple storage base_db rel t_right with + | Error _ -> assert false + | Ok p -> p + in + (match Manipulation.Memory.store_database storage right_db with + | Error _ -> assert false + | Ok () -> ()); + match + MergeMemory.merge ~storage ~strategy:Management.Merge.PreferLeft + ~left_tip:left_db.Management.Database.hash + ~right_tip:right_db.Management.Database.hash + with + | Error _ -> assert false + | Ok (Management.Merge.Failed _) -> assert false + | Ok (Management.Merge.Clean merged) -> + let merged_rel = + Option.get (Management.Database.get_relation merged "r") + in + assert (Manipulation.Memory.tuple_count merged_rel = 2)) let%test_unit "merge: no-op when both sides are identical" = with_storage (fun storage -> - let base_db = match Manipulation.Memory.create_database storage ~name:"db" with - | Error _ -> assert false | Ok db -> db - in - (match Manipulation.Memory.store_database storage base_db with - | Error _ -> assert false | Ok () -> ()); - match MergeMemory.merge ~storage ~strategy:Management.Merge.PreferLeft - ~left_tip:base_db.Management.Database.hash - ~right_tip:base_db.Management.Database.hash with - | Error _ -> assert false - | Ok (Management.Merge.Failed _) -> assert false - | Ok (Management.Merge.Clean merged) -> - assert (Management.Database.get_relation_names merged = - Management.Database.get_relation_names base_db)) + let base_db = + match Manipulation.Memory.create_database storage ~name:"db" with + | Error _ -> assert false + | Ok db -> db + in + (match Manipulation.Memory.store_database storage base_db with + | Error _ -> assert false + | Ok () -> ()); + match + MergeMemory.merge ~storage ~strategy:Management.Merge.PreferLeft + ~left_tip:base_db.Management.Database.hash + ~right_tip:base_db.Management.Database.hash + with + | Error _ -> assert false + | Ok (Management.Merge.Failed _) -> assert false + | Ok (Management.Merge.Clean merged) -> + assert ( + Management.Database.get_relation_names merged + = Management.Database.get_relation_names base_db)) (* Helper: look up polarity for a relation name in the result map *) -let find_polarity name pols = - Constraint.PolarityMap.find_opt name pols +let find_polarity name pols = Constraint.PolarityMap.find_opt name pols let%test_unit "polarity: MemberOf target is Positive" = - let c = Constraint.MemberOf { - target = "R"; - binding = Constraint.BindingMap.empty; - } in - assert (find_polarity "R" (Constraint.polarity_of c) = Some Constraint.Positive) + let c = + Constraint.MemberOf { target = "R"; binding = Constraint.BindingMap.empty } + in + assert ( + find_polarity "R" (Constraint.polarity_of c) = Some Constraint.Positive) let%test_unit "polarity: Not MemberOf flips to Negative" = - let c = Constraint.Not { - body = Constraint.MemberOf { target = "R"; binding = Constraint.BindingMap.empty }; - universe = "U"; - } in - assert (find_polarity "R" (Constraint.polarity_of c) = Some Constraint.Negative) + let c = + Constraint.Not + { + body = + Constraint.MemberOf + { target = "R"; binding = Constraint.BindingMap.empty }; + universe = "U"; + } + in + assert ( + find_polarity "R" (Constraint.polarity_of c) = Some Constraint.Negative) let%test_unit "polarity: Exists quantifier is Positive" = - let c = Constraint.Exists { - variable = "x"; - quantifier = "Q"; - body = Constraint.MemberOf { target = "Q"; binding = Constraint.BindingMap.empty }; - } in - assert (find_polarity "Q" (Constraint.polarity_of c) = Some Constraint.Positive) + let c = + Constraint.Exists + { + variable = "x"; + quantifier = "Q"; + body = + Constraint.MemberOf + { target = "Q"; binding = Constraint.BindingMap.empty }; + } + in + assert ( + find_polarity "Q" (Constraint.polarity_of c) = Some Constraint.Positive) let%test_unit "polarity: Forall quantifier is Negative" = - let c = Constraint.Forall { - variable = "x"; - quantifier = "Q"; - body = Constraint.MemberOf { target = "T"; binding = Constraint.BindingMap.empty }; - } in - assert (find_polarity "Q" (Constraint.polarity_of c) = Some Constraint.Negative); - assert (find_polarity "T" (Constraint.polarity_of c) = Some Constraint.Positive) + let c = + Constraint.Forall + { + variable = "x"; + quantifier = "Q"; + body = + Constraint.MemberOf + { target = "T"; binding = Constraint.BindingMap.empty }; + } + in + assert ( + find_polarity "Q" (Constraint.polarity_of c) = Some Constraint.Negative); + assert ( + find_polarity "T" (Constraint.polarity_of c) = Some Constraint.Positive) let%test_unit "polarity: same relation with both polarities merges to Both" = (* Not(MemberOf R) AND MemberOf R => R appears Negative and Positive => Both *) - let c = Constraint.And [ - Constraint.Not { - body = Constraint.MemberOf { target = "R"; binding = Constraint.BindingMap.empty }; - universe = "U"; - }; - Constraint.MemberOf { target = "R"; binding = Constraint.BindingMap.empty }; - ] in + let c = + Constraint.And + [ + Constraint.Not + { + body = + Constraint.MemberOf + { target = "R"; binding = Constraint.BindingMap.empty }; + universe = "U"; + }; + Constraint.MemberOf + { target = "R"; binding = Constraint.BindingMap.empty }; + ] + in assert (find_polarity "R" (Constraint.polarity_of c) = Some Constraint.Both) let%test_unit "polarity: Forall body MemberOf keeps Positive" = (* Forall x in Q, MemberOf(T): T still has positive polarity *) - let c = Constraint.Forall { - variable = "x"; - quantifier = "Q"; - body = Constraint.MemberOf { target = "T"; binding = Constraint.BindingMap.empty }; - } in - assert (find_polarity "T" (Constraint.polarity_of c) = Some Constraint.Positive) + let c = + Constraint.Forall + { + variable = "x"; + quantifier = "Q"; + body = + Constraint.MemberOf + { target = "T"; binding = Constraint.BindingMap.empty }; + } + in + assert ( + find_polarity "T" (Constraint.polarity_of c) = Some Constraint.Positive) let%test_unit "polarity: nested Not double-negation restores Positive" = - let c = Constraint.Not { - body = Constraint.Not { - body = Constraint.MemberOf { target = "R"; binding = Constraint.BindingMap.empty }; - universe = "U"; - }; - universe = "V"; - } in - assert (find_polarity "R" (Constraint.polarity_of c) = Some Constraint.Positive) + let c = + Constraint.Not + { + body = + Constraint.Not + { + body = + Constraint.MemberOf + { target = "R"; binding = Constraint.BindingMap.empty }; + universe = "U"; + }; + universe = "V"; + } + in + assert ( + find_polarity "R" (Constraint.polarity_of c) = Some Constraint.Positive) let%test_unit "polarity: unrelated relation absent from result" = - let c = Constraint.MemberOf { - target = "R"; - binding = Constraint.BindingMap.empty; - } in + let c = + Constraint.MemberOf { target = "R"; binding = Constraint.BindingMap.empty } + in assert (find_polarity "S" (Constraint.polarity_of c) = None) -let abs i = Obj.magic (i : int) (* lift int to AbstractValue for tests *) +let abs i = Obj.magic (i : int) (* lift int to AbstractValue for tests *) -let%test_unit "focused_filter: Var binding maps deleted value to constrained attr" = +let%test_unit + "focused_filter: Var binding maps deleted value to constrained attr" = (* Constraint: MemberOf Dept (dept_id = Var "dept_id") Deleted: Dept { dept_id = 99 } Expected filter: [("dept_id", 99)] @@ -2953,11 +3608,11 @@ let%test_unit "focused_filter: Var binding maps deleted value to constrained att Constraint.BindingMap.singleton "dept_id" (Constraint.Var "dept_id") in let c = Constraint.MemberOf { target = "Dept"; binding } in - let deleted = [("dept_id", abs 99)] in + let deleted = [ ("dept_id", abs 99) ] in let filter = Constraint.focused_filter c "Dept" deleted in assert (List.length filter = 1); assert (fst (List.hd filter) = "dept_id"); - assert (Stdlib.(=) (snd (List.hd filter)) (abs 99)) + assert (Stdlib.( = ) (snd (List.hd filter)) (abs 99)) let%test_unit "focused_filter: Const binding is ignored (no var link)" = (* Constraint: MemberOf Dept (code = Const "eng") @@ -2979,7 +3634,9 @@ let%test_unit "focused_filter: Const binding is ignored (no var link)" = (Constraint.Const (Obj.magic ("eng" : string))) in let c = Constraint.MemberOf { target = "Dept"; binding } in - let filter = Constraint.focused_filter c "Dept" [("code", Obj.magic ("eng" : string))] in + let filter = + Constraint.focused_filter c "Dept" [ ("code", Obj.magic ("eng" : string)) ] + in assert (filter = []) let%test_unit "focused_filter: Exists body MemberOf same relation is followed" = @@ -2998,12 +3655,15 @@ let%test_unit "focused_filter: Exists body MemberOf same relation is followed" = let binding = Constraint.BindingMap.singleton "dept_id" (Constraint.Var "dept_id") in - let c = Constraint.Exists { - variable = "d"; - quantifier = "Dept"; - body = Constraint.MemberOf { target = "Dept"; binding }; - } in - let filter = Constraint.focused_filter c "Dept" [("dept_id", abs 7)] in + let c = + Constraint.Exists + { + variable = "d"; + quantifier = "Dept"; + body = Constraint.MemberOf { target = "Dept"; binding }; + } + in + let filter = Constraint.focused_filter c "Dept" [ ("dept_id", abs 7) ] in assert (List.length filter = 1); assert (fst (List.hd filter) = "dept_id") @@ -3015,11 +3675,9 @@ let%test_unit "focused_filter: unrelated dep_rel yields empty filter" = the deletion cannot possibly affect any constrained tuple since no join variable links them. The cascade checker uses [] as a signal to skip the re-check for this constraint entirely, not to re-check everything. *) - let binding = - Constraint.BindingMap.singleton "x" (Constraint.Var "x") - in + let binding = Constraint.BindingMap.singleton "x" (Constraint.Var "x") in let c = Constraint.MemberOf { target = "R"; binding } in - let filter = Constraint.focused_filter c "S" [("x", abs 1)] in + let filter = Constraint.focused_filter c "S" [ ("x", abs 1) ] in assert (filter = []) let%test_unit "trigger_constants: Const value in binding is extracted" = @@ -3051,9 +3709,7 @@ let%test_unit "trigger_constants: Var binding produces no constant" = It is a join variable, not a filter. Any deleted tuple from R could match a constrained tuple via the Var link, so no early-exit is possible. [] means: always proceed to the cascade scan. *) - let binding = - Constraint.BindingMap.singleton "id" (Constraint.Var "id") - in + let binding = Constraint.BindingMap.singleton "id" (Constraint.Var "id") in let c = Constraint.MemberOf { target = "R"; binding } in let consts = Constraint.trigger_constants c "R" in assert (consts = []) @@ -3074,72 +3730,99 @@ let%test_unit "trigger_constants: unrelated dep_rel yields empty" = let consts = Constraint.trigger_constants c "S" in assert (consts = []) -let%test_unit "substitute_transition: Var \"variable.attr\" is replaced by Const from transition tuple" = +let%test_unit + "substitute_transition: Var \"variable.attr\" is replaced by Const from \ + transition tuple" = (* Constraint: Exists d in Department, MemberOf Target (key = Var "d.dept_id") Transition: Department row { dept_id = 99 } After substitution: Exists d in Department, MemberOf Target (key = Const 99) The namespaced Var "d.dept_id" (quantifier-scoped) is replaced; a base-tuple Var "dept_id" would not be. *) let c = - Constraint.Exists { - variable = "d"; quantifier = "Department"; - body = Constraint.MemberOf { - target = "Target"; - binding = Constraint.BindingMap.singleton "key" (Constraint.Var "d.dept_id"); - }; - } + Constraint.Exists + { + variable = "d"; + quantifier = "Department"; + body = + Constraint.MemberOf + { + target = "Target"; + binding = + Constraint.BindingMap.singleton "key" + (Constraint.Var "d.dept_id"); + }; + } + in + let result = + Constraint.substitute_transition c "Department" [ ("dept_id", abs 99) ] in - let result = Constraint.substitute_transition c "Department" [("dept_id", abs 99)] in - (match result with - | Constraint.Exists { body = Constraint.MemberOf { binding; _ }; _ } -> - (match Constraint.BindingMap.find_opt "key" binding with - | Some (Constraint.Const v) -> assert (Stdlib.(=) v (abs 99)) + match result with + | Constraint.Exists { body = Constraint.MemberOf { binding; _ }; _ } -> ( + match Constraint.BindingMap.find_opt "key" binding with + | Some (Constraint.Const v) -> assert (Stdlib.( = ) v (abs 99)) | _ -> assert false) - | _ -> assert false) + | _ -> assert false let%test_unit "substitute_transition: base-tuple Var is not substituted" = (* Constraint: Exists d in Department, MemberOf Target (key = Var "dept_id") Var "dept_id" is a base-tuple reference (no "d." prefix), so it must survive substitution unchanged. Only "d.dept_id" would be replaced. *) let c = - Constraint.Exists { - variable = "d"; quantifier = "Department"; - body = Constraint.MemberOf { - target = "Target"; - binding = Constraint.BindingMap.singleton "key" (Constraint.Var "dept_id"); - }; - } + Constraint.Exists + { + variable = "d"; + quantifier = "Department"; + body = + Constraint.MemberOf + { + target = "Target"; + binding = + Constraint.BindingMap.singleton "key" (Constraint.Var "dept_id"); + }; + } in - let result = Constraint.substitute_transition c "Department" [("dept_id", abs 99)] in - (match result with - | Constraint.Exists { body = Constraint.MemberOf { binding; _ }; _ } -> - (match Constraint.BindingMap.find_opt "key" binding with + let result = + Constraint.substitute_transition c "Department" [ ("dept_id", abs 99) ] + in + match result with + | Constraint.Exists { body = Constraint.MemberOf { binding; _ }; _ } -> ( + match Constraint.BindingMap.find_opt "key" binding with | Some (Constraint.Var "dept_id") -> () | _ -> assert false) - | _ -> assert false) + | _ -> assert false -let%test_unit "substitute_transition: non-matching quantifier relation is unchanged" = +let%test_unit + "substitute_transition: non-matching quantifier relation is unchanged" = (* Constraint: Exists d in Department, MemberOf Target (key = Var "d.dept_id") Transition is for relation "Other", not "Department". The body must survive unmodified. *) let c = - Constraint.Exists { - variable = "d"; quantifier = "Department"; - body = Constraint.MemberOf { - target = "Target"; - binding = Constraint.BindingMap.singleton "key" (Constraint.Var "d.dept_id"); - }; - } + Constraint.Exists + { + variable = "d"; + quantifier = "Department"; + body = + Constraint.MemberOf + { + target = "Target"; + binding = + Constraint.BindingMap.singleton "key" + (Constraint.Var "d.dept_id"); + }; + } + in + let result = + Constraint.substitute_transition c "Other" [ ("dept_id", abs 99) ] in - let result = Constraint.substitute_transition c "Other" [("dept_id", abs 99)] in - (match result with - | Constraint.Exists { body = Constraint.MemberOf { binding; _ }; _ } -> - (match Constraint.BindingMap.find_opt "key" binding with + match result with + | Constraint.Exists { body = Constraint.MemberOf { binding; _ }; _ } -> ( + match Constraint.BindingMap.find_opt "key" binding with | Some (Constraint.Var "d.dept_id") -> () | _ -> assert false) - | _ -> assert false) + | _ -> assert false -let%test_unit "substitute_transition: substitution applies through And and Not" = +let%test_unit "substitute_transition: substitution applies through And and Not" + = (* Constraint: Exists d in Department, And [ @@ -3149,75 +3832,112 @@ let%test_unit "substitute_transition: substitution applies through And and Not" Transition: { x = 1, y = 2 } After substitution: Var "d.x" -> Const 1, Var "d.y" -> Const 2 *) let c = - Constraint.Exists { - variable = "d"; quantifier = "Department"; - body = Constraint.And [ - Constraint.MemberOf { - target = "A"; - binding = Constraint.BindingMap.singleton "x" (Constraint.Var "d.x"); - }; - Constraint.Not { - universe = "B"; - body = Constraint.MemberOf { - target = "B"; - binding = Constraint.BindingMap.singleton "y" (Constraint.Var "d.y"); - }; - }; - ]; - } + Constraint.Exists + { + variable = "d"; + quantifier = "Department"; + body = + Constraint.And + [ + Constraint.MemberOf + { + target = "A"; + binding = + Constraint.BindingMap.singleton "x" (Constraint.Var "d.x"); + }; + Constraint.Not + { + universe = "B"; + body = + Constraint.MemberOf + { + target = "B"; + binding = + Constraint.BindingMap.singleton "y" + (Constraint.Var "d.y"); + }; + }; + ]; + } + in + let result = + Constraint.substitute_transition c "Department" + [ ("x", abs 1); ("y", abs 2) ] in - let result = Constraint.substitute_transition c "Department" [("x", abs 1); ("y", abs 2)] in - (match result with - | Constraint.Exists { - body = Constraint.And [ - Constraint.MemberOf { binding = b1; _ }; - Constraint.Not { body = Constraint.MemberOf { binding = b2; _ }; _ }; - ]; _ - } -> - (match Constraint.BindingMap.find_opt "x" b1, - Constraint.BindingMap.find_opt "y" b2 with + match result with + | Constraint.Exists + { + body = + Constraint.And + [ + Constraint.MemberOf { binding = b1; _ }; + Constraint.Not + { body = Constraint.MemberOf { binding = b2; _ }; _ }; + ]; + _; + } -> ( + match + ( Constraint.BindingMap.find_opt "x" b1, + Constraint.BindingMap.find_opt "y" b2 ) + with | Some (Constraint.Const v1), Some (Constraint.Const v2) -> - assert (Stdlib.(=) v1 (abs 1)); - assert (Stdlib.(=) v2 (abs 2)) + assert (Stdlib.( = ) v1 (abs 1)); + assert (Stdlib.( = ) v2 (abs 2)) | _ -> assert false) - | _ -> assert false) + | _ -> assert false (* Build a minimal db with two relations and an FK constraint: Department { dept_id } <-- Employee { emp_id, dept_id } Constraint on Employee: Exists d in Department, MemberOf Department (dept_id = Var "dept_id") *) let setup_fk_db storage = - let db = match Manipulation.Memory.create_database storage ~name:"hr" with - | Error _ -> assert false | Ok db -> db + let db = + match Manipulation.Memory.create_database storage ~name:"hr" with + | Error _ -> assert false + | Ok db -> db in - let db = match Manipulation.Memory.create_relation storage db ~name:"Department" - ~schema:(Schema.empty |> Schema.add "dept_id" "natural") with - | Error _ -> assert false | Ok (db, _) -> db + let db = + match + Manipulation.Memory.create_relation storage db ~name:"Department" + ~schema:(Schema.empty |> Schema.add "dept_id" "natural") + with + | Error _ -> assert false + | Ok (db, _) -> db in - let db = match Manipulation.Memory.create_relation storage db ~name:"Employee" - ~schema:(Schema.empty - |> Schema.add "emp_id" "natural" - |> Schema.add "dept_id" "natural") with - | Error _ -> assert false | Ok (db, _) -> db + let db = + match + Manipulation.Memory.create_relation storage db ~name:"Employee" + ~schema: + (Schema.empty + |> Schema.add "emp_id" "natural" + |> Schema.add "dept_id" "natural") + with + | Error _ -> assert false + | Ok (db, _) -> db in let fk_body = let binding = Constraint.BindingMap.singleton "dept_id" (Constraint.Var "dept_id") in - Constraint.Exists { - variable = "d"; - quantifier = "Department"; - body = Constraint.MemberOf { target = "Department"; binding }; - } + Constraint.Exists + { + variable = "d"; + quantifier = "Department"; + body = Constraint.MemberOf { target = "Department"; binding }; + } in - let db = match Manipulation.Memory.register_constraint storage db - ~constraint_name:"fk_dept" - ~relation_name:"Employee" - ~body:fk_body with - | Error _ -> assert false | Ok db -> db + let db = + match + Manipulation.Memory.register_constraint storage db + ~constraint_name:"fk_dept" ~relation_name:"Employee" ~body:fk_body + with + | Error _ -> assert false + | Ok db -> db in db -let%test_unit "extend_tuple namespacing: insert Employee with non-existent dept_id is rejected" = +let%test_unit + "extend_tuple namespacing: insert Employee with non-existent dept_id is \ + rejected" = (* Regression test for the extend_tuple namespacing bug. Without namespacing, extend_tuple would overwrite the Employee's dept_id=99 with the Department row's dept_id=1 during Exists iteration. Var "dept_id" @@ -3226,202 +3946,346 @@ let%test_unit "extend_tuple namespacing: insert Employee with non-existent dept_ With namespacing, Department attributes are stored as d.dept_id=1 and the base Employee attribute dept_id=99 is preserved, so the check correctly fails. *) with_storage (fun storage -> - let db = setup_fk_db storage in - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "Department"; - attributes = [("dept_id", Drl.Ast.Int 1)] }) with - | Error _ -> assert false | Ok db -> db - in - match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "Employee"; - attributes = [("emp_id", Drl.Ast.Int 1); - ("dept_id", Drl.Ast.Int 99)] }) with - | Ok _ -> assert false (* dept_id=99 does not exist in Department *) - | Error _ -> ()) + let db = setup_fk_db storage in + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "Department"; + attributes = [ ("dept_id", Drl.Ast.Int 1) ]; + }) + with + | Error _ -> assert false + | Ok db -> db + in + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "Employee"; + attributes = + [ ("emp_id", Drl.Ast.Int 1); ("dept_id", Drl.Ast.Int 99) ]; + }) + with + | Ok _ -> assert false (* dept_id=99 does not exist in Department *) + | Error _ -> ()) let%test_unit "cascade: delete referenced row violates FK and is rejected" = with_storage (fun storage -> - let db = setup_fk_db storage in - (* Insert Dept 1 and Employee referencing it *) - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "Department"; - attributes = [("dept_id", Drl.Ast.Int 1)] }) with - | Error _ -> assert false | Ok db -> db - in - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "Employee"; - attributes = [("emp_id", Drl.Ast.Int 10); - ("dept_id", Drl.Ast.Int 1)] }) with - | Error _ -> assert false | Ok db -> db - in - let dept_rel = match Manipulation.Memory.get_relation db ~name:"Department" with - | None -> assert false | Some r -> r - in - let dept_hash = Hashing.hash_tuple - { Tuple.relation = "Department"; - attributes = Tuple.AttributeMap.singleton "dept_id" - { Attribute.value = Obj.magic (1 : int) } } - in - (* Deleting Dept 1 while Employee references it must fail *) - match Manipulation.Memory.retract_tuple storage db dept_rel ~tuple_hash:dept_hash with - | Ok _ -> assert false (* should have been rejected *) - | Error (Manipulation.ConstraintViolation msg) -> - assert (String.length msg > 0) - | Error _ -> assert false) + let db = setup_fk_db storage in + (* Insert Dept 1 and Employee referencing it *) + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "Department"; + attributes = [ ("dept_id", Drl.Ast.Int 1) ]; + }) + with + | Error _ -> assert false + | Ok db -> db + in + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "Employee"; + attributes = + [ ("emp_id", Drl.Ast.Int 10); ("dept_id", Drl.Ast.Int 1) ]; + }) + with + | Error _ -> assert false + | Ok db -> db + in + let dept_rel = + match Manipulation.Memory.get_relation db ~name:"Department" with + | None -> assert false + | Some r -> r + in + let dept_hash = + Hashing.hash_tuple + { + Tuple.relation = "Department"; + attributes = + Tuple.AttributeMap.singleton "dept_id" + { Attribute.value = Obj.magic (1 : int) }; + } + in + (* Deleting Dept 1 while Employee references it must fail *) + match + Manipulation.Memory.retract_tuple storage db dept_rel + ~tuple_hash:dept_hash + with + | Ok _ -> assert false (* should have been rejected *) + | Error (Manipulation.ConstraintViolation msg) -> + assert (String.length msg > 0) + | Error _ -> assert false) let%test_unit "cascade: delete unreferenced row succeeds" = with_storage (fun storage -> - let db = setup_fk_db storage in - (* Insert two departments; employee only references dept 1 *) - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "Department"; - attributes = [("dept_id", Drl.Ast.Int 1)] }) with - | Error _ -> assert false | Ok db -> db - in - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "Department"; - attributes = [("dept_id", Drl.Ast.Int 2)] }) with - | Error _ -> assert false | Ok db -> db - in - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "Employee"; - attributes = [("emp_id", Drl.Ast.Int 10); - ("dept_id", Drl.Ast.Int 1)] }) with - | Error _ -> assert false | Ok db -> db - in - let dept_rel = match Manipulation.Memory.get_relation db ~name:"Department" with - | None -> assert false | Some r -> r - in - let dept2_hash = Hashing.hash_tuple - { Tuple.relation = "Department"; - attributes = Tuple.AttributeMap.singleton "dept_id" - { Attribute.value = Obj.magic (2 : int) } } - in - (* Deleting unreferenced Dept 2 must succeed *) - match Manipulation.Memory.retract_tuple storage db dept_rel ~tuple_hash:dept2_hash with - | Error _ -> assert false - | Ok (new_db, _) -> - let dept = match Manipulation.Memory.get_relation new_db ~name:"Department" with - | None -> assert false | Some r -> r + let db = setup_fk_db storage in + (* Insert two departments; employee only references dept 1 *) + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "Department"; + attributes = [ ("dept_id", Drl.Ast.Int 1) ]; + }) + with + | Error _ -> assert false + | Ok db -> db + in + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "Department"; + attributes = [ ("dept_id", Drl.Ast.Int 2) ]; + }) + with + | Error _ -> assert false + | Ok db -> db + in + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "Employee"; + attributes = + [ ("emp_id", Drl.Ast.Int 10); ("dept_id", Drl.Ast.Int 1) ]; + }) + with + | Error _ -> assert false + | Ok db -> db in - assert (Manipulation.Memory.tuple_count dept = 1)) + let dept_rel = + match Manipulation.Memory.get_relation db ~name:"Department" with + | None -> assert false + | Some r -> r + in + let dept2_hash = + Hashing.hash_tuple + { + Tuple.relation = "Department"; + attributes = + Tuple.AttributeMap.singleton "dept_id" + { Attribute.value = Obj.magic (2 : int) }; + } + in + (* Deleting unreferenced Dept 2 must succeed *) + match + Manipulation.Memory.retract_tuple storage db dept_rel + ~tuple_hash:dept2_hash + with + | Error _ -> assert false + | Ok (new_db, _) -> + let dept = + match + Manipulation.Memory.get_relation new_db ~name:"Department" + with + | None -> assert false + | Some r -> r + in + assert (Manipulation.Memory.tuple_count dept = 1)) let%test_unit "cascade: Negative-polarity relation deletion is not checked" = (* Constraint on Employee: NOT (MemberOf Blacklist (emp_id = Var "emp_id")) Blacklist has Negative polarity (INSERT into Blacklist could violate). DELETE from Blacklist should never trigger a cascade check. *) with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"hr" with - | Error _ -> assert false | Ok db -> db - in - let db = match Manipulation.Memory.create_relation storage db ~name:"Blacklist" - ~schema:(Schema.empty |> Schema.add "emp_id" "natural") with - | Error _ -> assert false | Ok (db, _) -> db - in - let db = match Manipulation.Memory.create_relation storage db ~name:"Employee" - ~schema:(Schema.empty |> Schema.add "emp_id" "natural") with - | Error _ -> assert false | Ok (db, _) -> db - in - let not_body = - let binding = - Constraint.BindingMap.singleton "emp_id" (Constraint.Var "emp_id") + let db = + match Manipulation.Memory.create_database storage ~name:"hr" with + | Error _ -> assert false + | Ok db -> db in - Constraint.Not { - body = Constraint.MemberOf { target = "Blacklist"; binding }; - universe = "Employee"; - } - in - let db = match Manipulation.Memory.register_constraint storage db - ~constraint_name:"not_blacklisted" - ~relation_name:"Employee" - ~body:not_body with - | Error _ -> assert false | Ok db -> db - in - (* Insert emp_id=5 into Blacklist, then insert emp_id=99 into Employee (unrelated) *) - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "Blacklist"; - attributes = [("emp_id", Drl.Ast.Int 5)] }) with - | Error _ -> assert false | Ok db -> db - in - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "Employee"; - attributes = [("emp_id", Drl.Ast.Int 99)] }) with - | Error _ -> assert false | Ok db -> db - in - let bl_rel = match Manipulation.Memory.get_relation db ~name:"Blacklist" with - | None -> assert false | Some r -> r - in - let bl_hash = Hashing.hash_tuple - { Tuple.relation = "Blacklist"; - attributes = Tuple.AttributeMap.singleton "emp_id" - { Attribute.value = Obj.magic (5 : int) } } - in - (* Deleting from Blacklist (negative polarity) must not trigger cascade check *) - match Manipulation.Memory.retract_tuple storage db bl_rel ~tuple_hash:bl_hash with - | Error _ -> assert false - | Ok _ -> ()) + let db = + match + Manipulation.Memory.create_relation storage db ~name:"Blacklist" + ~schema:(Schema.empty |> Schema.add "emp_id" "natural") + with + | Error _ -> assert false + | Ok (db, _) -> db + in + let db = + match + Manipulation.Memory.create_relation storage db ~name:"Employee" + ~schema:(Schema.empty |> Schema.add "emp_id" "natural") + with + | Error _ -> assert false + | Ok (db, _) -> db + in + let not_body = + let binding = + Constraint.BindingMap.singleton "emp_id" (Constraint.Var "emp_id") + in + Constraint.Not + { + body = Constraint.MemberOf { target = "Blacklist"; binding }; + universe = "Employee"; + } + in + let db = + match + Manipulation.Memory.register_constraint storage db + ~constraint_name:"not_blacklisted" ~relation_name:"Employee" + ~body:not_body + with + | Error _ -> assert false + | Ok db -> db + in + (* Insert emp_id=5 into Blacklist, then insert emp_id=99 into Employee (unrelated) *) + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "Blacklist"; + attributes = [ ("emp_id", Drl.Ast.Int 5) ]; + }) + with + | Error _ -> assert false + | Ok db -> db + in + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "Employee"; + attributes = [ ("emp_id", Drl.Ast.Int 99) ]; + }) + with + | Error _ -> assert false + | Ok db -> db + in + let bl_rel = + match Manipulation.Memory.get_relation db ~name:"Blacklist" with + | None -> assert false + | Some r -> r + in + let bl_hash = + Hashing.hash_tuple + { + Tuple.relation = "Blacklist"; + attributes = + Tuple.AttributeMap.singleton "emp_id" + { Attribute.value = Obj.magic (5 : int) }; + } + in + (* Deleting from Blacklist (negative polarity) must not trigger cascade check *) + match + Manipulation.Memory.retract_tuple storage db bl_rel ~tuple_hash:bl_hash + with + | Error _ -> assert false + | Ok _ -> ()) let%test_unit "cascade: deferred constraint not checked during retract_tuple" = with_storage (fun storage -> - let db = match Manipulation.Memory.create_database storage ~name:"hr" with - | Error _ -> assert false | Ok db -> db - in - let db = match Manipulation.Memory.create_relation storage db ~name:"Department" - ~schema:(Schema.empty |> Schema.add "dept_id" "natural") with - | Error _ -> assert false | Ok (db, _) -> db - in - let db = match Manipulation.Memory.create_relation storage db ~name:"Employee" - ~schema:(Schema.empty - |> Schema.add "emp_id" "natural" - |> Schema.add "dept_id" "natural") with - | Error _ -> assert false | Ok (db, _) -> db - in - let fk_body = - let binding = - Constraint.BindingMap.singleton "dept_id" (Constraint.Var "dept_id") + let db = + match Manipulation.Memory.create_database storage ~name:"hr" with + | Error _ -> assert false + | Ok db -> db in - Constraint.Exists { - variable = "d"; - quantifier = "Department"; - body = Constraint.MemberOf { target = "Department"; binding }; - } - in - (* Register as DEFERRED *) - let db = match Manipulation.Memory.attach_constraint storage db - ~constraint_name:"fk_dept_deferred" - ~relation_name:"Employee" - ~body:fk_body - ~timing:Constraint.Deferred with - | Error _ -> assert false | Ok db -> db - in - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "Department"; - attributes = [("dept_id", Drl.Ast.Int 1)] }) with - | Error _ -> assert false | Ok db -> db - in - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "Employee"; - attributes = [("emp_id", Drl.Ast.Int 10); - ("dept_id", Drl.Ast.Int 1)] }) with - | Error _ -> assert false | Ok db -> db - in - let dept_rel = match Manipulation.Memory.get_relation db ~name:"Department" with - | None -> assert false | Some r -> r - in - let dept_hash = Hashing.hash_tuple - { Tuple.relation = "Department"; - attributes = Tuple.AttributeMap.singleton "dept_id" - { Attribute.value = Obj.magic (1 : int) } } - in - (* Deferred: retract_tuple itself should NOT reject the deletion *) - match Manipulation.Memory.retract_tuple storage db dept_rel ~tuple_hash:dept_hash with - | Error _ -> assert false (* deferred: must pass here *) - | Ok (new_db, _) -> - (* But check_deferred_constraints must catch the violation *) - match Manipulation.Memory.check_deferred_constraints storage new_db with - | Ok () -> assert false (* should have caught the violation *) - | Error (Manipulation.ConstraintViolation _) -> () - | Error _ -> assert false) + let db = + match + Manipulation.Memory.create_relation storage db ~name:"Department" + ~schema:(Schema.empty |> Schema.add "dept_id" "natural") + with + | Error _ -> assert false + | Ok (db, _) -> db + in + let db = + match + Manipulation.Memory.create_relation storage db ~name:"Employee" + ~schema: + (Schema.empty + |> Schema.add "emp_id" "natural" + |> Schema.add "dept_id" "natural") + with + | Error _ -> assert false + | Ok (db, _) -> db + in + let fk_body = + let binding = + Constraint.BindingMap.singleton "dept_id" (Constraint.Var "dept_id") + in + Constraint.Exists + { + variable = "d"; + quantifier = "Department"; + body = Constraint.MemberOf { target = "Department"; binding }; + } + in + (* Register as DEFERRED *) + let db = + match + Manipulation.Memory.attach_constraint storage db + ~constraint_name:"fk_dept_deferred" ~relation_name:"Employee" + ~body:fk_body ~timing:Constraint.Deferred + with + | Error _ -> assert false + | Ok db -> db + in + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "Department"; + attributes = [ ("dept_id", Drl.Ast.Int 1) ]; + }) + with + | Error _ -> assert false + | Ok db -> db + in + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "Employee"; + attributes = + [ ("emp_id", Drl.Ast.Int 10); ("dept_id", Drl.Ast.Int 1) ]; + }) + with + | Error _ -> assert false + | Ok db -> db + in + let dept_rel = + match Manipulation.Memory.get_relation db ~name:"Department" with + | None -> assert false + | Some r -> r + in + let dept_hash = + Hashing.hash_tuple + { + Tuple.relation = "Department"; + attributes = + Tuple.AttributeMap.singleton "dept_id" + { Attribute.value = Obj.magic (1 : int) }; + } + in + (* Deferred: retract_tuple itself should NOT reject the deletion *) + match + Manipulation.Memory.retract_tuple storage db dept_rel + ~tuple_hash:dept_hash + with + | Error _ -> assert false (* deferred: must pass here *) + | Ok (new_db, _) -> ( + (* But check_deferred_constraints must catch the violation *) + match + Manipulation.Memory.check_deferred_constraints storage new_db + with + | Ok () -> assert false (* should have caught the violation *) + | Error (Manipulation.ConstraintViolation _) -> () + | Error _ -> assert false)) (* INSERT cascade tests. @@ -3435,64 +4299,109 @@ let%test_unit "cascade: deferred constraint not checked during retract_tuple" = Blacklist has Negative polarity in this constraint, so inserting into Blacklist must trigger a re-check of Employee tuples. *) let setup_blacklist_db storage = - let db = match Manipulation.Memory.create_database storage ~name:"hr" with - | Error _ -> assert false | Ok db -> db + let db = + match Manipulation.Memory.create_database storage ~name:"hr" with + | Error _ -> assert false + | Ok db -> db in - let db = match Manipulation.Memory.create_relation storage db ~name:"Blacklist" - ~schema:(Schema.empty |> Schema.add "emp_id" "natural") with - | Error _ -> assert false | Ok (db, _) -> db + let db = + match + Manipulation.Memory.create_relation storage db ~name:"Blacklist" + ~schema:(Schema.empty |> Schema.add "emp_id" "natural") + with + | Error _ -> assert false + | Ok (db, _) -> db in - let db = match Manipulation.Memory.create_relation storage db ~name:"Employee" - ~schema:(Schema.empty |> Schema.add "emp_id" "natural") with - | Error _ -> assert false | Ok (db, _) -> db + let db = + match + Manipulation.Memory.create_relation storage db ~name:"Employee" + ~schema:(Schema.empty |> Schema.add "emp_id" "natural") + with + | Error _ -> assert false + | Ok (db, _) -> db in let not_body = - Constraint.Not { - body = Constraint.MemberOf { - target = "Blacklist"; - binding = Constraint.BindingMap.singleton "emp_id" (Constraint.Var "emp_id"); - }; - universe = "Employee"; - } + Constraint.Not + { + body = + Constraint.MemberOf + { + target = "Blacklist"; + binding = + Constraint.BindingMap.singleton "emp_id" + (Constraint.Var "emp_id"); + }; + universe = "Employee"; + } in - match Manipulation.Memory.register_constraint storage db - ~constraint_name:"not_blacklisted" - ~relation_name:"Employee" - ~body:not_body with - | Error _ -> assert false | Ok db -> db + match + Manipulation.Memory.register_constraint storage db + ~constraint_name:"not_blacklisted" ~relation_name:"Employee" + ~body:not_body + with + | Error _ -> assert false + | Ok db -> db -let%test_unit "cascade INSERT: inserting into Blacklist violates constraint on existing Employee" = +let%test_unit + "cascade INSERT: inserting into Blacklist violates constraint on existing \ + Employee" = (* Employee emp_id=5 already exists. Inserting Blacklist{emp_id=5} must be rejected because the Employee constraint (NOT member of Blacklist) would be violated for the existing emp_id=5 row. *) with_storage (fun storage -> - let db = setup_blacklist_db storage in - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "Employee"; - attributes = [("emp_id", Drl.Ast.Int 5)] }) with - | Error _ -> assert false | Ok db -> db - in - match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "Blacklist"; - attributes = [("emp_id", Drl.Ast.Int 5)] }) with - | Ok _ -> assert false (* emp_id=5 exists in Employee, must be rejected *) - | Error _ -> ()) + let db = setup_blacklist_db storage in + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "Employee"; + attributes = [ ("emp_id", Drl.Ast.Int 5) ]; + }) + with + | Error _ -> assert false + | Ok db -> db + in + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "Blacklist"; + attributes = [ ("emp_id", Drl.Ast.Int 5) ]; + }) + with + | Ok _ -> assert false (* emp_id=5 exists in Employee, must be rejected *) + | Error _ -> ()) -let%test_unit "cascade INSERT: inserting into Blacklist with no matching Employee succeeds" = +let%test_unit + "cascade INSERT: inserting into Blacklist with no matching Employee \ + succeeds" = (* Employee emp_id=99 does not exist. Inserting Blacklist{emp_id=5} must succeed because no Employee tuple is affected. *) with_storage (fun storage -> - let db = setup_blacklist_db storage in - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "Employee"; - attributes = [("emp_id", Drl.Ast.Int 99)] }) with - | Error _ -> assert false | Ok db -> db - in - match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "Blacklist"; - attributes = [("emp_id", Drl.Ast.Int 5)] }) with - | Error _ -> assert false (* emp_id=5 not in Employee, must succeed *) - | Ok _ -> ()) + let db = setup_blacklist_db storage in + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "Employee"; + attributes = [ ("emp_id", Drl.Ast.Int 99) ]; + }) + with + | Error _ -> assert false + | Ok db -> db + in + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "Blacklist"; + attributes = [ ("emp_id", Drl.Ast.Int 5) ]; + }) + with + | Error _ -> assert false (* emp_id=5 not in Employee, must succeed *) + | Ok _ -> ()) (* commit tests. @@ -3500,108 +4409,179 @@ let%test_unit "cascade INSERT: inserting into Blacklist with no matching Employe Individual mutations succeed even when they temporarily violate the constraint; commit is the boundary where deferred violations are caught. *) let setup_deferred_fk_db storage = - let db = match Manipulation.Memory.create_database storage ~name:"hr" with - | Error _ -> assert false | Ok db -> db + let db = + match Manipulation.Memory.create_database storage ~name:"hr" with + | Error _ -> assert false + | Ok db -> db in - let db = match Manipulation.Memory.create_relation storage db ~name:"Department" - ~schema:(Schema.empty |> Schema.add "dept_id" "natural") with - | Error _ -> assert false | Ok (db, _) -> db + let db = + match + Manipulation.Memory.create_relation storage db ~name:"Department" + ~schema:(Schema.empty |> Schema.add "dept_id" "natural") + with + | Error _ -> assert false + | Ok (db, _) -> db in - let db = match Manipulation.Memory.create_relation storage db ~name:"Employee" - ~schema:(Schema.empty - |> Schema.add "emp_id" "natural" - |> Schema.add "dept_id" "natural") with - | Error _ -> assert false | Ok (db, _) -> db + let db = + match + Manipulation.Memory.create_relation storage db ~name:"Employee" + ~schema: + (Schema.empty + |> Schema.add "emp_id" "natural" + |> Schema.add "dept_id" "natural") + with + | Error _ -> assert false + | Ok (db, _) -> db in let fk_body = - Constraint.Exists { - variable = "d"; quantifier = "Department"; - body = Constraint.MemberOf { - target = "Department"; - binding = Constraint.BindingMap.singleton "dept_id" (Constraint.Var "dept_id"); - }; - } + Constraint.Exists + { + variable = "d"; + quantifier = "Department"; + body = + Constraint.MemberOf + { + target = "Department"; + binding = + Constraint.BindingMap.singleton "dept_id" + (Constraint.Var "dept_id"); + }; + } in - match Manipulation.Memory.attach_constraint storage db - ~constraint_name:"fk_dept" - ~relation_name:"Employee" - ~body:fk_body - ~timing:Constraint.Deferred with - | Error _ -> assert false | Ok db -> db + match + Manipulation.Memory.attach_constraint storage db ~constraint_name:"fk_dept" + ~relation_name:"Employee" ~body:fk_body ~timing:Constraint.Deferred + with + | Error _ -> assert false + | Ok db -> db let%test_unit "commit: no deferred constraints, returns Ok with db unchanged" = with_storage (fun storage -> - let db = setup_deferred_fk_db storage in - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "Department"; - attributes = [("dept_id", Drl.Ast.Int 1)] }) with - | Error _ -> assert false | Ok db -> db - in - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "Employee"; - attributes = [("emp_id", Drl.Ast.Int 10); - ("dept_id", Drl.Ast.Int 1)] }) with - | Error _ -> assert false | Ok db -> db - in - (* All constraints satisfied, commit must pass *) - match Manipulation.Memory.commit storage db with - | Error _ -> assert false - | Ok _ -> ()) + let db = setup_deferred_fk_db storage in + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "Department"; + attributes = [ ("dept_id", Drl.Ast.Int 1) ]; + }) + with + | Error _ -> assert false + | Ok db -> db + in + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "Employee"; + attributes = + [ ("emp_id", Drl.Ast.Int 10); ("dept_id", Drl.Ast.Int 1) ]; + }) + with + | Error _ -> assert false + | Ok db -> db + in + (* All constraints satisfied, commit must pass *) + match Manipulation.Memory.commit storage db with + | Error _ -> assert false + | Ok _ -> ()) let%test_unit "commit: deferred violation is caught at commit boundary" = with_storage (fun storage -> - let db = setup_deferred_fk_db storage in - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "Department"; - attributes = [("dept_id", Drl.Ast.Int 1)] }) with - | Error _ -> assert false | Ok db -> db - in - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "Employee"; - attributes = [("emp_id", Drl.Ast.Int 10); - ("dept_id", Drl.Ast.Int 1)] }) with - | Error _ -> assert false | Ok db -> db - in - let dept_rel = match Manipulation.Memory.get_relation db ~name:"Department" with - | None -> assert false | Some r -> r - in - let dept_hash = Hashing.hash_tuple - { Tuple.relation = "Department"; - attributes = Tuple.AttributeMap.singleton "dept_id" - { Attribute.value = Obj.magic (1 : int) } } - in - (* Delete the referenced department. Deferred, so retract succeeds *) - let db = match Manipulation.Memory.retract_tuple storage db dept_rel - ~tuple_hash:dept_hash with - | Error _ -> assert false | Ok (db, _) -> db - in - (* commit must now catch the orphaned Employee *) - match Manipulation.Memory.commit storage db with - | Ok _ -> assert false - | Error (Manipulation.ConstraintViolation _) -> () - | Error _ -> assert false) + let db = setup_deferred_fk_db storage in + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "Department"; + attributes = [ ("dept_id", Drl.Ast.Int 1) ]; + }) + with + | Error _ -> assert false + | Ok db -> db + in + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "Employee"; + attributes = + [ ("emp_id", Drl.Ast.Int 10); ("dept_id", Drl.Ast.Int 1) ]; + }) + with + | Error _ -> assert false + | Ok db -> db + in + let dept_rel = + match Manipulation.Memory.get_relation db ~name:"Department" with + | None -> assert false + | Some r -> r + in + let dept_hash = + Hashing.hash_tuple + { + Tuple.relation = "Department"; + attributes = + Tuple.AttributeMap.singleton "dept_id" + { Attribute.value = Obj.magic (1 : int) }; + } + in + (* Delete the referenced department. Deferred, so retract succeeds *) + let db = + match + Manipulation.Memory.retract_tuple storage db dept_rel + ~tuple_hash:dept_hash + with + | Error _ -> assert false + | Ok (db, _) -> db + in + (* commit must now catch the orphaned Employee *) + match Manipulation.Memory.commit storage db with + | Ok _ -> assert false + | Error (Manipulation.ConstraintViolation _) -> () + | Error _ -> assert false) let%test_unit "commit: clears deferred list, second commit passes" = (* After a successful commit the deferred list is empty. A follow-up mutation + commit on the returned db must also work correctly rather than re-running stale entries from the previous window. *) with_storage (fun storage -> - let db = setup_deferred_fk_db storage in - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "Department"; - attributes = [("dept_id", Drl.Ast.Int 1)] }) with - | Error _ -> assert false | Ok db -> db - in - let db = match Dml.Executor.Memory.execute storage db - (Dml.Ast.InsertTuple { relation = "Employee"; - attributes = [("emp_id", Drl.Ast.Int 10); - ("dept_id", Drl.Ast.Int 1)] }) with - | Error _ -> assert false | Ok db -> db - in - let db = match Manipulation.Memory.commit storage db with - | Error _ -> assert false | Ok db -> db - in - (* Second commit with no new mutations must also pass *) - match Manipulation.Memory.commit storage db with - | Error _ -> assert false - | Ok _ -> ()) + let db = setup_deferred_fk_db storage in + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "Department"; + attributes = [ ("dept_id", Drl.Ast.Int 1) ]; + }) + with + | Error _ -> assert false + | Ok db -> db + in + let db = + match + Dml.Executor.Memory.execute storage db + (Dml.Ast.InsertTuple + { + relation = "Employee"; + attributes = + [ ("emp_id", Drl.Ast.Int 10); ("dept_id", Drl.Ast.Int 1) ]; + }) + with + | Error _ -> assert false + | Ok db -> db + in + let db = + match Manipulation.Memory.commit storage db with + | Error _ -> assert false + | Ok db -> db + in + (* Second commit with no new mutations must also pass *) + match Manipulation.Memory.commit storage db with + | Error _ -> assert false + | Ok _ -> ()) |