From 18aa77d3f0afd827ee1c039b8eb287a4cf712a69 Mon Sep 17 00:00:00 2001 From: Romain Beguet Date: Wed, 25 Oct 2023 12:26:02 +0200 Subject: [PATCH 1/5] Do not crash on transitive self derivation. This one fixes fixedbugs test 1601-003. --- ada/ast.py | 22 +++++++++++----- .../invalid_self_reference/test.adb | 13 +++++++++- .../invalid_self_reference/test.out | 26 ++++++++++++++++++- 3 files changed, 53 insertions(+), 8 deletions(-) diff --git a/ada/ast.py b/ada/ast.py index 1b4fec861..3dd129232 100644 --- a/ada/ast.py +++ b/ada/ast.py @@ -3431,15 +3431,18 @@ def most_visible_part_for_name(sym=T.Symbol, only_backwards=(Bool, False)): Entity, # This part is visible, now check if the next part is as well - Entity.most_visible_forward_part_for_name(sym), + Entity.most_visible_forward_part_for_name(sym, seq=True), ) @langkit_property(return_type=T.BasicDecl.entity, dynamic_vars=[origin, default_imprecise_fallback()]) - def most_visible_forward_part_for_name(sym=T.Symbol): + def most_visible_forward_part_for_name(sym=T.Symbol, seq=T.Bool): """ Internal method for computing the most visible part (only looking forward) of a basic decl according to one of its defining names. + If ``seq`` is True, the visibility check is sequential: if a next + part is in the same unit as the origin but defined after it, it will + not be considered visible. """ np = Var(Entity.next_part_for_name(sym)) return Cond( @@ -3449,7 +3452,11 @@ def most_visible_forward_part_for_name(sym=T.Symbol): # A null origin means any "find the most complete part" origin.is_null, - np.most_visible_forward_part_for_name(sym), + np.most_visible_forward_part_for_name(sym, seq), + + # The query is sequential and origin can't see the next part + seq & (origin.unit == np.unit) & (origin <= np.node), + Entity, # If the entity is not a package declaration, we only need to check # if its lexical env is one of the parents of origin's env. @@ -3459,14 +3466,14 @@ def most_visible_forward_part_for_name(sym=T.Symbol): sym, categories=no_prims ).contains(Self.as_bare_entity), - np.most_visible_forward_part_for_name(sym), + np.most_visible_forward_part_for_name(sym, seq), Entity ), # Otherwise this is a package declaration, so we can use the # is_visible property. np.is_visible(origin.as_bare_entity), - np.most_visible_forward_part_for_name(sym), + np.most_visible_forward_part_for_name(sym, seq), # Otherwise this was the most visible part Entity @@ -17715,7 +17722,10 @@ def designated_type_impl(): origin.is_null, origin.bind( Self.origin_node, - t.most_visible_forward_part_for_name(t.name_symbol) + t.most_visible_forward_part_for_name( + t.name_symbol, + seq=False + ) ), t.most_visible_part ), diff --git a/testsuite/tests/name_resolution/invalid_self_reference/test.adb b/testsuite/tests/name_resolution/invalid_self_reference/test.adb index 0b835058f..6eec9cae9 100644 --- a/testsuite/tests/name_resolution/invalid_self_reference/test.adb +++ b/testsuite/tests/name_resolution/invalid_self_reference/test.adb @@ -7,11 +7,22 @@ procedure Test is --% node.f_type_expr.p_designated_type_decl -- This is invalid Ada but should not make LAL crash! + -- Likewise, the following invalid self derivations + -- should not make LAL crash: + type X; type X is new X; --% node.p_base_type(node) --% node.f_type_def.f_subtype_indication.p_designated_type_decl - -- Likewise, this should not make LAL crash + + type Y; + --% node.p_base_type(node) + type Z is new Y; + --% node.p_base_type(node) + --% node.f_type_def.f_subtype_indication.p_designated_type_decl + type Y is new Z; + --% node.p_base_type(node) + --% node.f_type_def.f_subtype_indication.p_designated_type_decl begin null; end Test; diff --git a/testsuite/tests/name_resolution/invalid_self_reference/test.out b/testsuite/tests/name_resolution/invalid_self_reference/test.out index 71d2988a6..24c7425ad 100644 --- a/testsuite/tests/name_resolution/invalid_self_reference/test.out +++ b/testsuite/tests/name_resolution/invalid_self_reference/test.out @@ -4,7 +4,7 @@ Working on node Eval 'node.f_type_expr.p_designated_type_decl' Result: None -Working on node +Working on node ============================================================ Eval 'node.p_base_type(node)' @@ -12,3 +12,27 @@ Result: None Eval 'node.f_type_def.f_subtype_indication.p_designated_type_decl' Result: None + +Working on node +============================================================== + +Eval 'node.p_base_type(node)' +Result: None + +Working on node +============================================================ + +Eval 'node.p_base_type(node)' +Result: + +Eval 'node.f_type_def.f_subtype_indication.p_designated_type_decl' +Result: + +Working on node +============================================================ + +Eval 'node.p_base_type(node)' +Result: + +Eval 'node.f_type_def.f_subtype_indication.p_designated_type_decl' +Result: From ab37f4afc401ec98cb58d00524da05159b330302 Mon Sep 17 00:00:00 2001 From: Romain Beguet Date: Thu, 26 Oct 2023 10:31:43 +0200 Subject: [PATCH 2/5] Cut self references by making use of the synthetic type predicate object. This allows reverting the initial commit on this issue. --- ada/ast.py | 31 ++++++++++--------- .../invalid_self_reference/test.adb | 4 +++ .../invalid_self_reference/test.out | 9 ++++++ 3 files changed, 29 insertions(+), 15 deletions(-) diff --git a/ada/ast.py b/ada/ast.py index 3dd129232..6f7796429 100644 --- a/ada/ast.py +++ b/ada/ast.py @@ -7809,14 +7809,6 @@ def predefined_operators(): add_to_env(Self.predefined_operators), add_env(), handle_children(), - reference( - Self.cast(AdaNode).singleton, - through=T.TypeDecl.refined_parent_primitives_env, - kind=RefKind.transitive, - dest_env=Self.node_env, - cond=Self.type_def.is_a(T.DerivedTypeDef, T.InterfaceTypeDef), - category="inherited_primitives" - ), # If this `TypeDecl` can have a predicate, add a synthetic object # declaration into its environement in order to support name resolution @@ -7828,7 +7820,21 @@ def predefined_operators(): Self.type_def.is_a(T.DerivedTypeDef, T.TypeAccessDef), Entity.synthetic_type_predicate_object_decl, No(T.env_assoc) - )) + )), + + # Make sure the reference to the primitives env is created *AFTER* the + # synthetic type predicate object has been added to Self's env: since + # this object has the same name as the type, it is indirectly used to + # hide the type and avoid infinite recursions in invalid Ada code such + # as ``type X is new X``. See nameres test `invalid_self_reference`. + reference( + Self.cast(AdaNode).singleton, + through=T.TypeDecl.refined_parent_primitives_env, + kind=RefKind.transitive, + dest_env=Self.node_env, + cond=Self.type_def.is_a(T.DerivedTypeDef, T.InterfaceTypeDef), + category="inherited_primitives" + ) ) record_def = Property( @@ -8640,12 +8646,7 @@ class DerivedTypeDef(TypeDef): default_val=Entity.super() )) - base_type = Property(Entity.subtype_indication.designated_type.then( - # If the designated type is Self, it means there is an illegal - # cycle. Explicitly return an null node here, otherwise this may - # cause infinite recursions in caller properties. - lambda t: If(t.node == Self.parent, No(BaseTypeDecl.entity), t) - )) + base_type = Property(Entity.subtype_indication.designated_type) base_interfaces = Property( Entity.interfaces.map(lambda i: i.name_designated_type) diff --git a/testsuite/tests/name_resolution/invalid_self_reference/test.adb b/testsuite/tests/name_resolution/invalid_self_reference/test.adb index 6eec9cae9..6558c12b2 100644 --- a/testsuite/tests/name_resolution/invalid_self_reference/test.adb +++ b/testsuite/tests/name_resolution/invalid_self_reference/test.adb @@ -23,6 +23,10 @@ procedure Test is type Y is new Z; --% node.p_base_type(node) --% node.f_type_def.f_subtype_indication.p_designated_type_decl + + type R is new R.T; + --% node.p_base_type(node) + --% node.f_type_def.f_subtype_indication.p_designated_type_decl begin null; end Test; diff --git a/testsuite/tests/name_resolution/invalid_self_reference/test.out b/testsuite/tests/name_resolution/invalid_self_reference/test.out index 24c7425ad..ff71c2739 100644 --- a/testsuite/tests/name_resolution/invalid_self_reference/test.out +++ b/testsuite/tests/name_resolution/invalid_self_reference/test.out @@ -36,3 +36,12 @@ Result: Eval 'node.f_type_def.f_subtype_indication.p_designated_type_decl' Result: + +Working on node +============================================================ + +Eval 'node.p_base_type(node)' +Result: None + +Eval 'node.f_type_def.f_subtype_indication.p_designated_type_decl' +Result: None From d22445672a8cf03d7bb956eeceaebf621d4f10bf Mon Sep 17 00:00:00 2001 From: Romain Beguet Date: Thu, 26 Oct 2023 17:50:19 +0200 Subject: [PATCH 3/5] Allow anonymous access on self in record definition. --- ada/ast.py | 31 ++++++++++++++++++- .../record_self_access/test.adb | 20 ++++++++++++ .../record_self_access/test.out | 26 ++++++++++++++++ .../record_self_access/test.yaml | 2 ++ 4 files changed, 78 insertions(+), 1 deletion(-) create mode 100644 testsuite/tests/name_resolution/record_self_access/test.adb create mode 100644 testsuite/tests/name_resolution/record_self_access/test.out create mode 100644 testsuite/tests/name_resolution/record_self_access/test.yaml diff --git a/ada/ast.py b/ada/ast.py index 6f7796429..07c4b4f65 100644 --- a/ada/ast.py +++ b/ada/ast.py @@ -1183,7 +1183,13 @@ def has_with_visibility(refd_unit=AnalysisUnit, @langkit_property(return_type=Bool) def has_visibility(other_entity=T.AdaNode.entity): - return Or( + # If we found a synthetic type predicate object decl, it means we are + # inside the definition of the type. From there, check if we indeed + # have visibility on the synthetic object. + return other_entity.cast(SyntheticTypePredicateObjectDecl).then( + lambda sod: sod.is_referred_by(Self), + default_val=True + ) & Or( # The node is a generic package instantiation coming from a formal # package. other_entity.cast(GenericPackageInstantiation)._.info.from_rebound, @@ -9168,6 +9174,29 @@ class SyntheticTypePredicateObjectDecl(BasicDecl): type_expression = Property(Self.type_expr.as_entity) defining_names = Property(Self.name.as_entity.singleton) + @langkit_property(return_type=T.Bool) + def is_referred_by(origin=T.AdaNode): + """ + Return whether a synthetic type predicate object can be seen from the + given ``origin`` node. This already assumes that we are inside a type + definition (otherwise the env lookup would not have found the synthetic + object), but this can be used to know if the reference points to the + synthetic object or to the type itself. By default this will always be + the synthetic object, unless we are in an access type definition. This + allows correctly resolving: + + .. code:: ada + + type T is record + X : access T := T'Unrestricted_Access; + -- (1) (2) + end record; + + Here, the reference (1) points to the type, whereas (2) refers to the + synthetic object. + """ + return Not(origin.parent.parent.is_a(TypeAccessDef)) + @synthetic class DiscreteBaseSubtypeDecl(BaseSubtypeDecl): diff --git a/testsuite/tests/name_resolution/record_self_access/test.adb b/testsuite/tests/name_resolution/record_self_access/test.adb new file mode 100644 index 000000000..551e343cc --- /dev/null +++ b/testsuite/tests/name_resolution/record_self_access/test.adb @@ -0,0 +1,20 @@ +procedure Test is + type P is tagged null record; + type T is new P with record + X : access T; + --% access_type = node.f_component_def.f_type_expr.f_type_decl + --% access_type.f_type_def.f_subtype_indication.p_designated_type_decl + --% access_type.f_type_def.f_subtype_indication.f_name.p_referenced_decl() + end record; + + type T_2 is new P with record + X : access T_2 := T_2'Unrestricted_Access; + --% access_type = node.f_component_def.f_type_expr.f_type_decl + --% access_type.f_type_def.f_subtype_indication.f_name.p_referenced_decl() + --% access_type.f_type_def.f_subtype_indication.p_designated_type_decl + --% node.f_default_expr.f_prefix.p_referenced_decl() + end record; +begin + null; +end Test; + diff --git a/testsuite/tests/name_resolution/record_self_access/test.out b/testsuite/tests/name_resolution/record_self_access/test.out new file mode 100644 index 000000000..2cda62d90 --- /dev/null +++ b/testsuite/tests/name_resolution/record_self_access/test.out @@ -0,0 +1,26 @@ +Working on node +======================================================= + +Set 'access_type' to 'node.f_component_def.f_type_expr.f_type_decl' +Result: + +Eval 'access_type.f_type_def.f_subtype_indication.p_designated_type_decl' +Result: + +Eval 'access_type.f_type_def.f_subtype_indication.f_name.p_referenced_decl()' +Result: + +Working on node +========================================================= + +Set 'access_type' to 'node.f_component_def.f_type_expr.f_type_decl' +Result: + +Eval 'access_type.f_type_def.f_subtype_indication.f_name.p_referenced_decl()' +Result: + +Eval 'access_type.f_type_def.f_subtype_indication.p_designated_type_decl' +Result: + +Eval 'node.f_default_expr.f_prefix.p_referenced_decl()' +Result: diff --git a/testsuite/tests/name_resolution/record_self_access/test.yaml b/testsuite/tests/name_resolution/record_self_access/test.yaml new file mode 100644 index 000000000..35ad4d5c4 --- /dev/null +++ b/testsuite/tests/name_resolution/record_self_access/test.yaml @@ -0,0 +1,2 @@ +driver: inline-playground +input_sources: [test.adb] From 3c459e5e2fe0a529e8dbf04bfb045ae5a51680c8 Mon Sep 17 00:00:00 2001 From: Romain Beguet Date: Fri, 27 Oct 2023 17:21:18 +0200 Subject: [PATCH 4/5] Rework initial_env of contract pragmas. This makes sure there is parent-children relation between the pragma node and the type or subprogram it is associated with, to make it easier to know whether we are inside such a contract. --- ada/ast.py | 39 +++++++++++++++++---------------------- 1 file changed, 17 insertions(+), 22 deletions(-) diff --git a/ada/ast.py b/ada/ast.py index 07c4b4f65..12ce3ffb8 100644 --- a/ada/ast.py +++ b/ada/ast.py @@ -10156,26 +10156,6 @@ def is_ghost_code(): 'Assert', 'Assert_And_Cut', 'Assume', 'Loop_Invariant' ) - @langkit_property() - def xref_initial_env(): - """ - Contract pragmas such as ``Precondition`` have full visibility on their - associated subprogram's formals although they are not in an internal - scope. We handle that by overriding this ``xref_initial_env`` property - which will make sure that name resolution uses the env returned by this - property when constructing xref_equations. - """ - return If( - Entity.id.name_symbol.any_of( - "Pre", "Post", "Pre'Class", "Post'Class", - "Precondition", "Postcondition", - "Precondition'Class", "Postcondition'Class", - "Test_Case", "Contract_Cases", "Predicate" - ), - Entity.associated_entities.at(0).children_env, - Entity.children_env - ) - @langkit_property() def xref_equation(): return Cond( @@ -10487,11 +10467,26 @@ def associated_entities(): def initial_env(): """ Return the initial env name for a pragma clause. We use the - Standard package for top level use clauses. + Standard package for top level use clauses. For contract pragmas such + as ``Precondition`` or ``Predicate``, we use the env of the entity the + pragma is associated with in order to properly resolve references to + formals or to the type's ``SyntheticTypePredicateObjectDecl`` instance. """ - return If( + return Cond( Self.parent.parent.is_a(CompilationUnit), named_env('Standard'), + + Self.as_bare_entity.id.name_symbol.any_of( + "Pre", "Post", "Pre'Class", "Post'Class", + "Precondition", "Postcondition", + "Precondition'Class", "Postcondition'Class", + "Test_Case", "Contract_Cases", "Predicate" + ), + Self.as_bare_entity.associated_entities.at(0).then( + lambda ent: direct_env(ent.children_env), + default_val=current_env() + ), + current_env() ) From 1dddaf7999fae1ccdc816d72cc84d570b2948257 Mon Sep 17 00:00:00 2001 From: Romain Beguet Date: Fri, 27 Oct 2023 17:06:42 +0200 Subject: [PATCH 5/5] A type predicate object can only be seen from within the type definition. --- ada/ast.py | 22 +++++++++++-------- .../record_self_access/test.adb | 13 +++++++++++ .../record_self_access/test.out | 9 ++++++++ 3 files changed, 35 insertions(+), 9 deletions(-) diff --git a/ada/ast.py b/ada/ast.py index 12ce3ffb8..70743ed13 100644 --- a/ada/ast.py +++ b/ada/ast.py @@ -1183,9 +1183,8 @@ def has_with_visibility(refd_unit=AnalysisUnit, @langkit_property(return_type=Bool) def has_visibility(other_entity=T.AdaNode.entity): - # If we found a synthetic type predicate object decl, it means we are - # inside the definition of the type. From there, check if we indeed - # have visibility on the synthetic object. + # We found a synthetic type predicate object decl, check if we are + # allowed to see it. return other_entity.cast(SyntheticTypePredicateObjectDecl).then( lambda sod: sod.is_referred_by(Self), default_val=True @@ -9178,11 +9177,9 @@ class SyntheticTypePredicateObjectDecl(BasicDecl): def is_referred_by(origin=T.AdaNode): """ Return whether a synthetic type predicate object can be seen from the - given ``origin`` node. This already assumes that we are inside a type - definition (otherwise the env lookup would not have found the synthetic - object), but this can be used to know if the reference points to the - synthetic object or to the type itself. By default this will always be - the synthetic object, unless we are in an access type definition. This + given ``origin`` node. If we are outside the type definition, this will + always be the type itself. Otherwise this will always be the synthetic + object, unless we are in an access type definition. In particular, this allows correctly resolving: .. code:: ada @@ -9195,7 +9192,14 @@ def is_referred_by(origin=T.AdaNode): Here, the reference (1) points to the type, whereas (2) refers to the synthetic object. """ - return Not(origin.parent.parent.is_a(TypeAccessDef)) + return And( + Not(origin.parent.parent.is_a(TypeAccessDef)), + Self.is_children_env( + Self.type_expr.cast(SyntheticTypeExpr) + .target_type.children_env, + origin.children_env + ) + ) @synthetic diff --git a/testsuite/tests/name_resolution/record_self_access/test.adb b/testsuite/tests/name_resolution/record_self_access/test.adb index 551e343cc..c423d0dbd 100644 --- a/testsuite/tests/name_resolution/record_self_access/test.adb +++ b/testsuite/tests/name_resolution/record_self_access/test.adb @@ -14,6 +14,19 @@ procedure Test is --% access_type.f_type_def.f_subtype_indication.p_designated_type_decl --% node.f_default_expr.f_prefix.p_referenced_decl() end record; + + type A is record + B : Integer; + end record; + + type B is new A; + + procedure Assign (X : in out B; Y : B) is + begin + X.B := Y.B; + --% node.f_dest.f_suffix.p_referenced_decl() + --% node.f_expr.f_suffix.p_referenced_decl() + end Assign; begin null; end Test; diff --git a/testsuite/tests/name_resolution/record_self_access/test.out b/testsuite/tests/name_resolution/record_self_access/test.out index 2cda62d90..41eee657f 100644 --- a/testsuite/tests/name_resolution/record_self_access/test.out +++ b/testsuite/tests/name_resolution/record_self_access/test.out @@ -24,3 +24,12 @@ Result: Eval 'node.f_default_expr.f_prefix.p_referenced_decl()' Result: + +Working on node +================================================ + +Eval 'node.f_dest.f_suffix.p_referenced_decl()' +Result: + +Eval 'node.f_expr.f_suffix.p_referenced_decl()' +Result: