From 663f5ee0a1eb54f632a8ef9563ad276b6f2d8197 Mon Sep 17 00:00:00 2001 From: Tienson Qin Date: Tue, 22 Sep 2026 05:44:05 +0000 Subject: [PATCH] Fix query predicate bindings over :in vars, intra-tx lookup refs, EDN symbol chars - query_where: substitute :in bindings into equality/comparison-N predicates, arithmetic/value clauses, source clauses, and not/not-join clauses in bound_relation_clause so the relation fast path no longer drops rows for [(= ?v ?target)] / [(not= ...)] over :in-bound vars - transact: resolve entity-map attr values per attr at add time against the accumulating tx datoms (upstream sequential [:db/add] order) so lookup refs see datoms added by earlier attrs of the same entity map; upsert probes resolve non-strictly like upstream resolve-upserts - parser: ' is a non-terminating macro char in EDN, so it is legal mid-symbol; remove it from the delimiter set so symbols/keywords like foo*+!_'?<>=- tokenize like upstream cljs reader - tests: new test_query_engine_fixes suite covering recursive-rule direction, predicates over :in scalars and collections, intra-tx lookup refs, and EDN symbol special chars; upstream alias entries added for ported tests --- impl/parser.ml | 2 +- impl/query_where.ml | 27 ++- impl/transact.ml | 64 +++++--- test/dune | 5 + test/test_query_engine_fixes.ml | 282 ++++++++++++++++++++++++++++++++ test/upstream_test_aliases.tsv | 5 + 6 files changed, 362 insertions(+), 23 deletions(-) create mode 100644 test/test_query_engine_fixes.ml diff --git a/impl/parser.ml b/impl/parser.ml index de71a0c..da228b7 100644 --- a/impl/parser.ml +++ b/impl/parser.ml @@ -73,7 +73,7 @@ let read_edn input = | _ -> false in let is_delimiter = function - | '[' | ']' | '(' | ')' | '{' | '}' | '"' | '\'' -> true + | '[' | ']' | '(' | ')' | '{' | '}' | '"' -> true | c -> is_whitespace c in let rec skip index = diff --git a/impl/query_where.ml b/impl/query_where.ml index bb7d0bb..2a5ccdd 100644 --- a/impl/query_where.ml +++ b/impl/query_where.ml @@ -1678,7 +1678,7 @@ end) = struct | QValue (Keyword attr | String attr | Symbol attr) -> QAttr attr | term -> term - let bound_relation_clause binding = function + let rec bound_relation_clause binding = function | Pattern (e_term, a_term, v_term) -> Pattern ( bound_pattern_term binding e_term @@ -1723,6 +1723,31 @@ end) = struct | ComparisonPredicate (predicate, left_term, right_term) -> ComparisonPredicate (predicate, bound_pattern_term binding left_term, bound_pattern_term binding right_term) + | ComparisonPredicateN (predicate, terms) -> + ComparisonPredicateN (predicate, List.map (bound_pattern_term binding) terms) + | EqualityPredicate (predicate, terms) -> + EqualityPredicate (predicate, List.map (bound_pattern_term binding) terms) + | ArithmeticValue (op, terms, output_var) -> + ArithmeticValue (op, List.map (bound_pattern_term binding) terms, output_var) + | NameValue (term, output_var) -> + NameValue (bound_pattern_term binding term, output_var) + | NamespaceValue (term, output_var) -> + NamespaceValue (bound_pattern_term binding term, output_var) + | KeywordFromName (term, output_var) -> + KeywordFromName (bound_pattern_term binding term, output_var) + | KeywordFromNamespaceName (namespace_term, name_term, output_var) -> + KeywordFromNamespaceName + (bound_pattern_term binding namespace_term, bound_pattern_term binding name_term, output_var) + | SourceClause (source_name, clause) -> + SourceClause (source_name, bound_relation_clause binding clause) + | Not clauses -> + Not (List.map (bound_relation_clause binding) clauses) + | SourceNot (source_name, clauses) -> + SourceNot (source_name, List.map (bound_relation_clause binding) clauses) + | NotJoin (vars, clauses) -> + NotJoin (vars, List.map (bound_relation_clause binding) clauses) + | SourceNotJoin (source_name, vars, clauses) -> + SourceNotJoin (source_name, vars, List.map (bound_relation_clause binding) clauses) | clause -> clause let relation_prefix_clause = function diff --git a/impl/transact.ml b/impl/transact.ml index 9609225..693bf04 100644 --- a/impl/transact.ml +++ b/impl/transact.ml @@ -726,12 +726,39 @@ let apply_tx context tx_ops db = if entity.db_id = None && has_only_forward_nested_attrs entity then apply_nested_first_entity_map (datoms, max_eid, tempids, entity_tempids, tx_data) entity else - let e, attrs, datoms, max_eid, tempids, tx_data = + (* Upsert probes resolve non-strictly against the pre-entity datoms: + unresolvable refs keep their raw form and simply never match. Strict + resolution happens per attr at add time, matching upstream's + sequential [:db/add] resolution order. *) + let probe_attrs = + let probe_attrs, _, _ = + List.fold_left + (fun (probe_attrs, max_eid, tempids) (attr, tx_value) -> + match + (try + Some + (resolve_tx_value_for_attr + context.resolve_context + db + attr + datoms + tx + max_eid + tempids + tx_value) + with Invalid_argument _ -> None) + with + | Some (tx_value, max_eid, tempids) -> + (attr, tx_value) :: probe_attrs, max_eid, tempids + | None -> (attr, tx_value) :: probe_attrs, max_eid, tempids) + ([], max_eid, tempids) + entity.attrs + in + List.rev probe_attrs + in + let e, datoms, max_eid, tempids, tx_data = match entity.db_id with | Some (Temp_id tempid) -> - let probe_attrs, _, _ = - resolve_entity_attrs context.resolve_context db datoms tx max_eid tempids entity.attrs - in (match context.entity_unique_identity db datoms probe_attrs with | Some target_e -> let datoms, tempids, tx_data = @@ -741,29 +768,21 @@ let apply_tx context tx_ops db = | Some _ -> datoms, tempids, tx_data | None -> datoms, remember_tempid tempids tempid target_e, tx_data in - let attrs, max_eid, tempids = - resolve_entity_attrs context.resolve_context db datoms tx max_eid tempids entity.attrs - in - target_e, attrs, datoms, context.resolve_context.max_eid_with_entity_id max_eid target_e, tempids, tx_data + target_e, datoms, context.resolve_context.max_eid_with_entity_id max_eid target_e, tempids, tx_data | None -> let e, max_eid, tempids = resolve_entity_ref context.resolve_context db datoms tx max_eid tempids (Temp_id tempid) in - let attrs, max_eid, tempids = - resolve_entity_attrs context.resolve_context db datoms tx max_eid tempids entity.attrs - in - e, attrs, datoms, max_eid, tempids, tx_data) + e, datoms, max_eid, tempids, tx_data) | Some entity_ref -> let e, max_eid, tempids = resolve_entity_ref context.resolve_context db datoms tx max_eid tempids entity_ref in - let attrs, max_eid, tempids = resolve_entity_attrs context.resolve_context db datoms tx max_eid tempids entity.attrs in - context.validate_explicit_upsert_target db datoms e attrs; - e, attrs, datoms, max_eid, tempids, tx_data + context.validate_explicit_upsert_target db datoms e probe_attrs; + e, datoms, max_eid, tempids, tx_data | None -> let e = context.resolve_context.allocate_entity_id max_eid in - let attrs, max_eid, tempids = resolve_entity_attrs context.resolve_context db datoms tx e tempids entity.attrs in - (match context.entity_unique_identity db datoms attrs with - | Some e -> e, attrs, datoms, context.resolve_context.max_eid_with_entity_id max_eid e, tempids, tx_data - | None -> e, attrs, datoms, max_eid, tempids, tx_data) + (match context.entity_unique_identity db datoms probe_attrs with + | Some e -> e, datoms, context.resolve_context.max_eid_with_entity_id max_eid e, tempids, tx_data + | None -> e, datoms, context.resolve_context.max_eid_with_entity_id max_eid e, tempids, tx_data) in let entity_tempids = match entity.db_id with @@ -771,7 +790,7 @@ let apply_tx context tx_ops db = | None -> entity_tempids in let tuple_identity_lookup_writes = - attrs + probe_attrs |> List.filter_map (function | attr, One_value value when context.is_tuple_attr db attr && context.is_unique_identity db attr -> (match context.resolve_context.entid datoms attr value with @@ -851,6 +870,9 @@ let apply_tx context tx_ops db = end in let apply_attr (datoms, max_eid, tempids, entity_tempids, tx_data, tuple_sources, direct_tuple_writes) (attr, tx_value) = + let tx_value, max_eid, tempids = + resolve_tx_value_for_attr context.resolve_context db attr datoms tx max_eid tempids tx_value + in match tx_value with | One_value (List values | Vector values) when attr_expands_collection context.resolve_context db attr -> List.fold_left @@ -878,7 +900,7 @@ let apply_tx context tx_ops db = nested_entities in let datoms, max_eid, tempids, entity_tempids, tx_data, tuple_sources, direct_tuple_writes = - List.fold_left apply_attr (datoms, max_eid, tempids, entity_tempids, tx_data, [], []) attrs + List.fold_left apply_attr (datoms, max_eid, tempids, entity_tempids, tx_data, [], []) entity.attrs in let tuple_sources = List.sort_uniq compare tuple_sources in let datoms, tx_data = diff --git a/test/dune b/test/dune index 6666a0e..62a5721 100644 --- a/test/dune +++ b/test/dune @@ -244,3 +244,8 @@ %{dep:cross_runtime_parity_test.sh} %{dep:cross_runtime_ocaml.exe} %{dep:../script/cross_runtime_upstream.js}))) + +(test + (name test_query_engine_fixes) + (modules test_query_engine_fixes) + (libraries datascript-ocaml-native)) diff --git a/test/test_query_engine_fixes.ml b/test/test_query_engine_fixes.ml new file mode 100644 index 0000000..112308b --- /dev/null +++ b/test/test_query_engine_fixes.ml @@ -0,0 +1,282 @@ +open Datascript + +let failf fmt = Printf.ksprintf failwith fmt + +let assert_rows label expected actual = + let norm rows = List.sort compare rows in + if norm expected <> norm actual then failf "%s" label + +let rules_of_string s = Parser.parse_rules (Parser.read_edn s) + +(* Bug 1: recursive rules should walk the graph in the direction the body says. + Upstream: datascript/test/query_rules.cljc test-rules *) +let test_recursive_rules_direction () = + let db = + empty_db () + |> db_with + [ Add (Entity_id 1, "follow", Ref 2) + ; Add (Entity_id 2, "follow", Ref 3) + ; Add (Entity_id 3, "follow", Ref 4) + ] + in + let rules = + rules_of_string + "[[(follow ?x ?y) [?x :follow ?y]] + [(follow ?x ?y) [?x :follow ?t] (follow ?t ?y)]]" + in + assert_rows + "recursive rule returns all follow pairs" + [ [ Result_entity 1; Result_entity 2 ] + ; [ Result_entity 1; Result_entity 3 ] + ; [ Result_entity 1; Result_entity 4 ] + ; [ Result_entity 2; Result_entity 3 ] + ; [ Result_entity 2; Result_entity 4 ] + ; [ Result_entity 3; Result_entity 4 ] + ] + (q_string ~inputs:[ Arg_rules rules ] db + "[:find ?e1 ?e2 :in $ % :where (follow ?e1 ?e2)]") + +let test_rule_branches_positional_binding () = + (* Upstream "Rule with branches": head var names (?e2 ?e1) intentionally differ + from the invocation args; binding must be positional. init_db keeps all raw + datoms like upstream's datom-vector inputs. *) + let db = + init_db + [ datom ~e:5 ~a:"follow" ~v:(Ref 3) () + ; datom ~e:1 ~a:"follow" ~v:(Ref 2) () + ; datom ~e:2 ~a:"follow" ~v:(Ref 3) () + ; datom ~e:3 ~a:"follow" ~v:(Ref 4) () + ; datom ~e:4 ~a:"follow" ~v:(Ref 6) () + ; datom ~e:2 ~a:"follow" ~v:(Ref 4) () + ] + in + let rules = + rules_of_string + "[[(follow ?e2 ?e1) [?e2 :follow ?e1]] + [(follow ?e2 ?e1) [?e2 :follow ?t] [?t :follow ?e1]]]" + in + assert_rows + "rule head vars bind positionally, not by name" + [ [ Result_entity 2 ]; [ Result_entity 3 ]; [ Result_entity 4 ] ] + (q_string ~inputs:[ Arg_scalar (Result_entity 1); Arg_rules rules ] db + "[:find ?e2 :in $ ?e1 % :where (follow ?e1 ?e2)]") + +let test_recursive_rule_swapped_args () = + (* Upstream "Recursive rules": self-call with swapped args produces the + symmetric closure *) + let db = + empty_db () + |> db_with + [ Add (Entity_id 1, "follow", Ref 2) + ; Add (Entity_id 2, "follow", Ref 3) + ] + in + let rules = + rules_of_string + "[[(follow ?e1 ?e2) [?e1 :follow ?e2]] + [(follow ?e1 ?e2) (follow ?e2 ?e1)]]" + in + assert_rows + "recursive self-call with swapped args yields symmetric pairs" + [ [ Result_entity 1; Result_entity 2 ] + ; [ Result_entity 2; Result_entity 3 ] + ; [ Result_entity 2; Result_entity 1 ] + ; [ Result_entity 3; Result_entity 2 ] + ] + (q_string ~inputs:[ Arg_rules rules ] db + "[:find ?e1 ?e2 :in $ % :where (follow ?e1 ?e2)]") + +(* Bug 2: predicates over :in-bound scalars must see the bindings *) +let test_predicate_over_in_scalar () = + let db = + empty_db () + |> db_with + [ Entity { db_id = Some (Entity_id 1); attrs = [ "attr", One_value (Int 1) ] } + ; Entity { db_id = Some (Entity_id 2); attrs = [ "attr", One_value (Int 2) ] } + ] + in + assert_rows + "[(= ?v ?target)] filters by :in binding" + [ [ Result_entity 2 ] ] + (q_string ~inputs:[ Arg_scalar (Result_value (Int 2)) ] db + "[:find ?e :in $ ?target :where [?e :attr ?v] [(= ?v ?target)]]") + +(* Bug 3: collection-form :in binds each element *) +let test_collection_in_binding () = + let db = + empty_db () + |> db_with + [ Entity { db_id = Some (Entity_id 1); attrs = [ "attr", One_value (Int 1) ] } + ; Entity { db_id = Some (Entity_id 2); attrs = [ "attr", One_value (Int 2) ] } + ; Entity { db_id = Some (Entity_id 3); attrs = [ "attr", One_value (Int 3) ] } + ] + in + assert_rows + "[?x ...] collection :in iterates elements" + [ [ Result_entity 1 ]; [ Result_entity 3 ] ] + (q_string ~inputs:[ Arg_collection [ Result_value (Int 1); Result_value (Int 3) ] ] db + "[:find ?e :in $ [?x ...] :where [?e :attr ?x]]") + +(* Bug 2 extended: comparison predicates over :in-bound vars *) +let test_comparison_predicates_over_in () = + let db = + empty_db () + |> db_with + [ Entity { db_id = Some (Entity_id 1); attrs = [ "d", One_value (Int 1) ] } + ; Entity { db_id = Some (Entity_id 2); attrs = [ "d", One_value (Int 3) ] } + ; Entity { db_id = Some (Entity_id 3); attrs = [ "d", One_value (Int 5) ] } + ] + in + assert_rows + "[(<= ?d ?cutoff)] filters by :in binding" + [ [ Result_entity 1 ]; [ Result_entity 2 ] ] + (q_string ~inputs:[ Arg_scalar (Result_value (Int 3)) ] db + "[:find ?e :in $ ?cutoff :where [?e :d ?d] [(<= ?d ?cutoff)]]"); + assert_rows + "[(not= ?d ?x)] filters by :in binding" + [ [ Result_entity 1 ]; [ Result_entity 3 ] ] + (q_string ~inputs:[ Arg_scalar (Result_value (Int 3)) ] db + "[:find ?e :in $ ?x :where [?e :d ?d] [(not= ?d ?x)]]") + +(* Bug 2 extended: predicate over collection-bound :in var sees each element *) +let test_predicate_over_collection_in () = + let db = + empty_db () + |> db_with + [ Entity { db_id = Some (Entity_id 1); attrs = [ "attr", One_value (Int 1) ] } + ; Entity { db_id = Some (Entity_id 2); attrs = [ "attr", One_value (Int 3) ] } + ] + in + assert_rows + "[(= ?v ?x)] sees collection :in elements" + [ [ Result_entity 1 ]; [ Result_entity 2 ] ] + (q_string ~inputs:[ Arg_collection [ Result_value (Int 1); Result_value (Int 3) ] ] db + "[:find ?e :in $ [?x ...] :where [?e :attr ?v] [(= ?v ?x)]]") + +(* Bug 5: lookup refs inside a transaction resolve against the db with the + pending tx datoms, matching upstream's sequential transact-add semantics *) +let block_schema () = + let base_attr = + { cardinality = One; unique = None; indexed = false; is_component = false + ; no_history = false; doc = None; value_type = None; tuple_attrs = None + ; tuple_types = None } + in + [ "block/uuid", { base_attr with unique = Some Identity; indexed = true } + ; "block/parent", { base_attr with value_type = Some RefType } + ] + +let lookup_ref attr value = List [ Keyword attr; value ] + +let test_entity_map_lookup_ref_earlier_tx_entity () = + let u1 = "11111111-1111-1111-1111-111111111111" in + let u2 = "22222222-2222-2222-2222-222222222222" in + let db = + empty_db ~schema:(block_schema ()) () + |> db_with + [ Entity { db_id = None; attrs = [ "block/uuid", One_value (Uuid u1) ] } + ; Entity + { db_id = None + ; attrs = + [ "block/uuid", One_value (Uuid u2) + ; "block/parent", One_value (lookup_ref "block/uuid" (Uuid u1)) + ] + } + ] + in + let parent_datoms = + datoms db Aevt ~a:"block/parent" () + |> List.of_seq + |> List.map (fun d -> d.e, d.v) + in + if parent_datoms <> [ 2, Ref 1 ] then + failf "lookup ref to earlier-tx entity should resolve to e=1, got %d datoms" (List.length parent_datoms); + (* upstream test-lookup-refs-transact: "lookup refs are resolved at + intermediate DB value" — Add ops resolve against the pending tx too *) + let u3 = "33333333-3333-3333-3333-333333333333" in + let db = + empty_db ~schema:(block_schema ()) () + |> db_with + [ Entity { db_id = None; attrs = [ "block/uuid", One_value (Uuid u1) ] } + ; Add (Entity_id 3, "block/uuid", Uuid u3) + ; Add (Entity_id 1, "block/parent", lookup_ref "block/uuid" (Uuid u3)) + ] + in + let parent_datoms = + datoms db Aevt ~a:"block/parent" () + |> List.of_seq + |> List.map (fun d -> d.e, d.v) + in + if parent_datoms <> [ 1, Ref 3 ] then failf "Add lookup ref to earlier-tx entity should resolve to e=3" + +let test_entity_map_lookup_ref_same_entity () = + (* An entity map's earlier attrs must be visible when resolving a later + attr's lookup ref, matching upstream's sequential add order *) + let u1 = "11111111-1111-1111-1111-111111111111" in + let db = + empty_db ~schema:(block_schema ()) () + |> db_with + [ Entity + { db_id = None + ; attrs = + [ "block/uuid", One_value (Uuid u1) + ; "block/parent", One_value (lookup_ref "block/uuid" (Uuid u1)) + ] + } + ] + in + let parent_datoms = + datoms db Aevt ~a:"block/parent" () + |> List.of_seq + |> List.map (fun d -> d.e, d.v) + in + if parent_datoms <> [ 1, Ref 1 ] then failf "self lookup ref should resolve to the same entity e=1" + +let test_entity_map_lookup_ref_unresolved_raises () = + let u1 = "11111111-1111-1111-1111-111111111111" in + (try + ignore + (empty_db ~schema:(block_schema ()) () + |> db_with + [ Entity + { db_id = None + ; attrs = [ "block/parent", One_value (lookup_ref "block/uuid" (Uuid u1)) ] + } + ]); + failf "unresolvable lookup ref should raise" + with + | Invalid_argument msg -> + if not + (String.starts_with ~prefix:"Nothing found for entity id" msg) + then + failf "unexpected error message: %s" msg) + +(* Bug 6: EDN reader accepts ' and friends inside symbol/keyword bodies *) +let test_edn_symbol_special_chars () = + (match Parser.read_edn "{:user.property/foo*+!_'?<>=- nil}" with + | QueryFormMap [ QueryFormKeyword "user.property/foo*+!_'?<>=-", QueryFormNil ] -> () + | _ -> failf "read_edn should parse keywords containing *+!_'?<>=-"); + (match Parser.read_edn "[sym' foo*+!_'?<>=- 'quoted ?var]" with + | QueryFormVector + [ QueryFormSymbol "sym'" + ; QueryFormSymbol "foo*+!_'?<>=-" + ; QueryFormSymbol "quoted" + ; QueryFormSymbol "?var" ] -> () + | _ -> failf "read_edn should parse symbols containing *+!_'?<>=- and leading 'quote") + +let () = + List.iter + (fun (name, f) -> + f (); + Printf.printf "%s ok\n" name) + [ "recursive_rules_direction", test_recursive_rules_direction + ; "rule_branches_positional_binding", test_rule_branches_positional_binding + ; "recursive_rule_swapped_args", test_recursive_rule_swapped_args + ; "predicate_over_in_scalar", test_predicate_over_in_scalar + ; "collection_in_binding", test_collection_in_binding + ; "comparison_predicates_over_in", test_comparison_predicates_over_in + ; "predicate_over_collection_in", test_predicate_over_collection_in + ; "entity_map_lookup_ref_earlier_tx_entity", test_entity_map_lookup_ref_earlier_tx_entity + ; "entity_map_lookup_ref_same_entity", test_entity_map_lookup_ref_same_entity + ; "entity_map_lookup_ref_unresolved_raises", test_entity_map_lookup_ref_unresolved_raises + ; "edn_symbol_special_chars", test_edn_symbol_special_chars + ] diff --git a/test/upstream_test_aliases.tsv b/test/upstream_test_aliases.tsv index 9223fd7..ab3c753 100644 --- a/test/upstream_test_aliases.tsv +++ b/test/upstream_test_aliases.tsv @@ -18,11 +18,16 @@ index.cljc test-datom test_upstream_index_api_parity_batch index.cljc test-seek-datoms test_upstream_index_api_parity_batch index.cljc test-rseek-datoms test_upstream_index_api_parity_batch index.cljc test-index-range test_upstream_index_api_parity_batch +lookup_refs.cljc test-lookup-refs-transact test_entity_map_lookup_ref_earlier_tx_entity query.cljc test-nested-bindings test_q_nested_relation_map_inputs +query.cljc test-bindings test_collection_in_binding query_find_specs.cljc test-find-specs test_q_return_find_specs_match_upstream_cases query_fns.cljc test-exceptions test_q_builtin_function_insufficient_bindings_match_upstream_messages query_fns.cljc test-issue-180 test_q_with_dynamic_callable_inputs query_fns.cljc test-issue-445 test_q_with_lookup_ref_inputs_in_entity_builtins +query_rules.cljc test-rules test_recursive_rules_direction +query_rules.cljc test-rules test_rule_branches_positional_binding +query_rules.cljc test-rules test_recursive_rule_swapped_args query_return_map.cljc test-find-specs test_q_return_map_string_upstream_shape_batch query_v3.cljc test-validation test_q_input_arity_matches_upstream_validation_messages validation.cljc test-with-validation test_db_with_string_matches_upstream_validation_messages