diff --git a/ada/ast.py b/ada/ast.py index a1deed161..c41ed810d 100644 --- a/ada/ast.py +++ b/ada/ast.py @@ -11753,19 +11753,28 @@ def xref_equation(): @langkit_property(return_type=Equation, dynamic_vars=[env, origin]) def base_id_xref_equation(): env_els = Var(Entity.env_elements) + is_prefix = Var(Not(Self.is_suffix)) - return ( - Self.ref_var.domain(env_els) + return env_els.logic_any( + lambda e: + Bind(Self.ref_var, e) & Bind(Self.ref_var, Self.type_var, BasicDecl.expr_type, eq_prop=BaseTypeDecl.matching_type) + & If( + # If this BaseId refers to an enclosing subprogram and is + # the prefix of a dotted name, then it is not a call. + is_prefix & e.cast(T.BaseSubpBody)._.in_scope, - # If this BaseId represents a call, the called subprogram will be - # held in Self.ref_var, in which case subp_spec_or_null will - # return the specification of the called subprogram. If ref_var - # does not contain a subprogram, this BaseId cannot be a call, - # and subp_spec_or_null would indeed return null in this case. - & Bind(Self.ref_var, Self.subp_spec_var, - conv_prop=BasicDecl.subp_spec_or_null) + LogicTrue(), + + # If this BaseId represents a call, the called subprogram will + # be held in Self.ref_var, in which case subp_spec_or_null will + # return the specification of the called subprogram. If ref_var + # does not contain a subprogram, this BaseId cannot be a call, + # and subp_spec_or_null would indeed return null in this case. + Bind(Self.ref_var, Self.subp_spec_var, + conv_prop=BasicDecl.subp_spec_or_null) + ) ) diff --git a/testsuite/tests/properties/is_call_enclosing_subp/test.adb b/testsuite/tests/properties/is_call_enclosing_subp/test.adb new file mode 100644 index 000000000..055958031 --- /dev/null +++ b/testsuite/tests/properties/is_call_enclosing_subp/test.adb @@ -0,0 +1,15 @@ +procedure Test is + function Temp (x,y: Integer) return Boolean is Null; + + procedure Outer_Procedure (x: Integer) is + function Inner_Procedure (x: Integer) return Boolean is + begin + return Temp (Outer_Procedure.x, x); + --% node.f_return_expr.f_suffix[0].f_r_expr.f_prefix.p_is_call + end Inner_Procedure; + begin + Null; + end Outer_Procedure; +begin + null; +end Test; diff --git a/testsuite/tests/properties/is_call_enclosing_subp/test.out b/testsuite/tests/properties/is_call_enclosing_subp/test.out new file mode 100644 index 000000000..6af6dbd6f --- /dev/null +++ b/testsuite/tests/properties/is_call_enclosing_subp/test.out @@ -0,0 +1,4 @@ +Eval 'node.f_return_expr.f_suffix[0].f_r_expr.f_prefix.p_is_call' on node +Result: False + + diff --git a/testsuite/tests/properties/is_call_enclosing_subp/test.yaml b/testsuite/tests/properties/is_call_enclosing_subp/test.yaml new file mode 100644 index 000000000..35ad4d5c4 --- /dev/null +++ b/testsuite/tests/properties/is_call_enclosing_subp/test.yaml @@ -0,0 +1,2 @@ +driver: inline-playground +input_sources: [test.adb] diff --git a/user_manual/changes/TC15-033.yaml b/user_manual/changes/TC15-033.yaml new file mode 100644 index 000000000..0edc3c43f --- /dev/null +++ b/user_manual/changes/TC15-033.yaml @@ -0,0 +1,14 @@ +type: bugfix +title: Fix ``p_is_call`` on qualified subprogram name +description: | + This change fixes a bug where a qualified subprogram name could be wrongly + tagged as a call, as in the following example: + + .. code:: ada + + function Foo (X : Integer) return Integer is + begin + return Foo.X; -- `Foo` was wrongly considered a call + end Foo; + +date: 2021-03-08