Skip to content

Commit

Permalink
Merge branch 'topic/1079' into 'master'
Browse files Browse the repository at this point in the history 
Better name resolution support for nested recursive procedures

Closes #1079

See merge request eng/libadalang/libadalang!1415
  • Loading branch information
@thvnx
thvnx committed Nov 22, 2023
2 parents 55256b2 + 436b5df commit 8eac42d
Show file tree
Hide file tree
Showing 7 changed files with 329 additions and 3 deletions.
49 changes: 46 additions & 3 deletions ada/ast.py
View file
Original file line number Diff line number Diff line change
Expand Up @@ -531,6 +531,16 @@ def semantic_parent():
"""
return Entity.semantic_parent_helper(Entity.node_env)

@langkit_property(return_type=T.AdaNode.entity.array)
def semantic_parents():
"""
Recursively call ``semantic_parent`` to get all the semantic parents
of this node.
"""
return Entity.semantic_parent.then(
lambda sp: sp.singleton.concat(sp.semantic_parents)
)

@langkit_property(public=True, return_type=T.BasicDecl.entity)
def parent_basic_decl():
"""
Expand Down Expand Up @@ -3747,8 +3757,20 @@ def in_scope():
"""
return And(
Not(origin.is_null),
origin.unit == Self.unit,
Not(origin.parents.find(lambda p: p == Self).is_null)
Or(
# Either origin and Self are in the same unit
And(
origin.unit == Self.unit,
Not(origin.parents.find(lambda p: p == Self).is_null)
),
# Either origin is nested in a subprogam subunit of Self
origin.enclosing_compilation_unit.body.cast(T.Subunit).then(
lambda su: su.bodies_root.any(
lambda br: br.is_a(T.BaseSubpBody)
& (br.unit == Self.unit)
)
)
)
)

@langkit_property()
Expand Down Expand Up @@ -18081,7 +18103,7 @@ def env_elements_baseid():
# local variables.
If(
is_prefix,
Entity.parents.find(
Entity.semantic_parents.find(
lambda n: n.is_a(T.TaskBody, T.BaseSubpBody).then(
lambda _:
n.cast(T.BasicDecl).defining_name
Expand Down Expand Up @@ -22576,6 +22598,27 @@ def body_root():
"""
return Self.root_unit.decl.as_bare_entity

@langkit_property(return_type=T.BasicDecl.entity.array)
def bodies_root():
"""
Return all the bodies this subunit is rooted in, so that for:

.. code::ada

separate (P1.P2.P3)
procedure P4 is ...

``bodies_root`` will return ``[P3, P2, P1]``, an array containing all
the nested subunits (``P2``, ``P3``), as well as the body root ``P1``,
in which ``P4`` has been recursively rooted in.
"""
br = Var(Self.root_unit.decl.as_bare_entity)

return br.parent.cast(T.Subunit).then(
lambda su: br.singleton.concat(su.bodies_root),
default_val=br.singleton
)

@langkit_property(
return_type=T.BodyStub,
# At the time of its introduction, this property was used only by
Expand Down
21 changes: 21 additions & 0 deletions testsuite/tests/name_resolution/recursive_subunit/p1-p2-p3-p4.adb
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,21 @@
separate (P1.P2.P3)
procedure P4 is
S : String (1 .. 2);
C : Character;
begin
S := P2.S;
pragma Test_Statement;

C := P1.C;
pragma Test_Statement;

C := P2.H;
pragma Test_Statement;

S := P3.S;
pragma Test_Statement;

C := P3.C;
pragma Test_Statement;

end P4;
15 changes: 15 additions & 0 deletions testsuite/tests/name_resolution/recursive_subunit/p1-p2-p3.adb
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,15 @@
separate (P1.P2)
procedure P3 is
S : String (1 .. 2);
C : Character;
procedure P4 is separate;
begin
S := P2.S;
pragma Test_Statement;

C := P1.C;
pragma Test_Statement;

C := P2.H;
pragma Test_Statement;
end P3;
12 changes: 12 additions & 0 deletions testsuite/tests/name_resolution/recursive_subunit/p1-p2.adb
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,12 @@
separate (P1)
procedure P2 (H : Character) is
S : String (1 .. 2);
C : Character;
procedure P3 is separate;
begin
C := P1.C;
pragma Test_Statement;

S := P1.C & "-";
pragma Test_Statement;
end P2;
6 changes: 6 additions & 0 deletions testsuite/tests/name_resolution/recursive_subunit/p1.adb
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
procedure P1 is
C : constant Character := '1';
procedure P2 (H : Character) is separate;
begin
null;
end P1;
227 changes: 227 additions & 0 deletions testsuite/tests/name_resolution/recursive_subunit/test.out
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,227 @@
Analyzing p1-p2.adb
###################

Resolving xrefs for node <AssignStmt p1-p2.adb:7:6-7:16>
********************************************************

Expr: <Id "C" p1-p2.adb:7:6-7:7>
references: <DefiningName "C" p1-p2.adb:4:6-4:7>
type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
expected type: None
Expr: <DottedName p1-p2.adb:7:11-7:15>
references: <DefiningName "C" p1.adb:2:6-2:7>
type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
expected type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
Expr: <Id "P1" p1-p2.adb:7:11-7:13>
references: <DefiningName "P1" p1.adb:1:11-1:13>
type: None
expected type: None
Expr: <Id "C" p1-p2.adb:7:14-7:15>
references: <DefiningName "C" p1.adb:2:6-2:7>
type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
expected type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>

Resolving xrefs for node <AssignStmt p1-p2.adb:10:6-10:22>
**********************************************************

Expr: <Id "S" p1-p2.adb:10:6-10:7>
references: <DefiningName "S" p1-p2.adb:3:6-3:7>
type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>
expected type: None
Expr: <ConcatOp p1-p2.adb:10:11-10:21>
type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>
expected type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>
Expr: <DottedName p1-p2.adb:10:11-10:15>
references: <DefiningName "C" p1.adb:2:6-2:7>
type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
expected type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
Expr: <Id "P1" p1-p2.adb:10:11-10:13>
references: <DefiningName "P1" p1.adb:1:11-1:13>
type: None
expected type: None
Expr: <Id "C" p1-p2.adb:10:14-10:15>
references: <DefiningName "C" p1.adb:2:6-2:7>
type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
expected type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
Expr: <ConcatOperand p1-p2.adb:10:16-10:21>
type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>
expected type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>
Expr: <OpConcat "&" p1-p2.adb:10:16-10:17>
references: None
type: None
expected type: None
Expr: <Str ""-"" p1-p2.adb:10:18-10:21>
references: None
type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>
expected type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>


Analyzing p1-p2-p3.adb
######################

Resolving xrefs for node <AssignStmt p1-p2-p3.adb:7:6-7:16>
***********************************************************

Expr: <Id "S" p1-p2-p3.adb:7:6-7:7>
references: <DefiningName "S" p1-p2-p3.adb:3:6-3:7>
type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>
expected type: None
Expr: <DottedName p1-p2-p3.adb:7:11-7:15>
references: <DefiningName "S" p1-p2.adb:3:6-3:7>
type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>
expected type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>
Expr: <Id "P2" p1-p2-p3.adb:7:11-7:13>
references: <DefiningName "P2" p1-p2.adb:2:11-2:13>
type: None
expected type: None
Expr: <Id "S" p1-p2-p3.adb:7:14-7:15>
references: <DefiningName "S" p1-p2.adb:3:6-3:7>
type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>
expected type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>

Resolving xrefs for node <AssignStmt p1-p2-p3.adb:10:6-10:16>
*************************************************************

Expr: <Id "C" p1-p2-p3.adb:10:6-10:7>
references: <DefiningName "C" p1-p2-p3.adb:4:6-4:7>
type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
expected type: None
Expr: <DottedName p1-p2-p3.adb:10:11-10:15>
references: <DefiningName "C" p1.adb:2:6-2:7>
type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
expected type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
Expr: <Id "P1" p1-p2-p3.adb:10:11-10:13>
references: <DefiningName "P1" p1.adb:1:11-1:13>
type: None
expected type: None
Expr: <Id "C" p1-p2-p3.adb:10:14-10:15>
references: <DefiningName "C" p1.adb:2:6-2:7>
type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
expected type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>

Resolving xrefs for node <AssignStmt p1-p2-p3.adb:13:6-13:16>
*************************************************************

Expr: <Id "C" p1-p2-p3.adb:13:6-13:7>
references: <DefiningName "C" p1-p2-p3.adb:4:6-4:7>
type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
expected type: None
Expr: <DottedName p1-p2-p3.adb:13:11-13:15>
references: <DefiningName "H" p1-p2.adb:2:15-2:16>
type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
expected type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
Expr: <Id "P2" p1-p2-p3.adb:13:11-13:13>
references: <DefiningName "P2" p1-p2.adb:2:11-2:13>
type: None
expected type: None
Expr: <Id "H" p1-p2-p3.adb:13:14-13:15>
references: <DefiningName "H" p1-p2.adb:2:15-2:16>
type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
expected type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>


Analyzing p1-p2-p3-p4.adb
#########################

Resolving xrefs for node <AssignStmt p1-p2-p3-p4.adb:6:6-6:16>
**************************************************************

Expr: <Id "S" p1-p2-p3-p4.adb:6:6-6:7>
references: <DefiningName "S" p1-p2-p3-p4.adb:3:6-3:7>
type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>
expected type: None
Expr: <DottedName p1-p2-p3-p4.adb:6:11-6:15>
references: <DefiningName "S" p1-p2.adb:3:6-3:7>
type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>
expected type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>
Expr: <Id "P2" p1-p2-p3-p4.adb:6:11-6:13>
references: <DefiningName "P2" p1-p2.adb:2:11-2:13>
type: None
expected type: None
Expr: <Id "S" p1-p2-p3-p4.adb:6:14-6:15>
references: <DefiningName "S" p1-p2.adb:3:6-3:7>
type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>
expected type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>

Resolving xrefs for node <AssignStmt p1-p2-p3-p4.adb:9:6-9:16>
**************************************************************

Expr: <Id "C" p1-p2-p3-p4.adb:9:6-9:7>
references: <DefiningName "C" p1-p2-p3-p4.adb:4:6-4:7>
type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
expected type: None
Expr: <DottedName p1-p2-p3-p4.adb:9:11-9:15>
references: <DefiningName "C" p1.adb:2:6-2:7>
type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
expected type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
Expr: <Id "P1" p1-p2-p3-p4.adb:9:11-9:13>
references: <DefiningName "P1" p1.adb:1:11-1:13>
type: None
expected type: None
Expr: <Id "C" p1-p2-p3-p4.adb:9:14-9:15>
references: <DefiningName "C" p1.adb:2:6-2:7>
type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
expected type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>

Resolving xrefs for node <AssignStmt p1-p2-p3-p4.adb:12:6-12:16>
****************************************************************

Expr: <Id "C" p1-p2-p3-p4.adb:12:6-12:7>
references: <DefiningName "C" p1-p2-p3-p4.adb:4:6-4:7>
type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
expected type: None
Expr: <DottedName p1-p2-p3-p4.adb:12:11-12:15>
references: <DefiningName "H" p1-p2.adb:2:15-2:16>
type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
expected type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
Expr: <Id "P2" p1-p2-p3-p4.adb:12:11-12:13>
references: <DefiningName "P2" p1-p2.adb:2:11-2:13>
type: None
expected type: None
Expr: <Id "H" p1-p2-p3-p4.adb:12:14-12:15>
references: <DefiningName "H" p1-p2.adb:2:15-2:16>
type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
expected type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>

Resolving xrefs for node <AssignStmt p1-p2-p3-p4.adb:15:6-15:16>
****************************************************************

Expr: <Id "S" p1-p2-p3-p4.adb:15:6-15:7>
references: <DefiningName "S" p1-p2-p3-p4.adb:3:6-3:7>
type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>
expected type: None
Expr: <DottedName p1-p2-p3-p4.adb:15:11-15:15>
references: <DefiningName "S" p1-p2-p3.adb:3:6-3:7>
type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>
expected type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>
Expr: <Id "P3" p1-p2-p3-p4.adb:15:11-15:13>
references: <DefiningName "P3" p1-p2-p3.adb:2:11-2:13>
type: None
expected type: None
Expr: <Id "S" p1-p2-p3-p4.adb:15:14-15:15>
references: <DefiningName "S" p1-p2-p3.adb:3:6-3:7>
type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>
expected type: <ConcreteTypeDecl ["String"] __standard:105:3-105:57>

Resolving xrefs for node <AssignStmt p1-p2-p3-p4.adb:18:6-18:16>
****************************************************************

Expr: <Id "C" p1-p2-p3-p4.adb:18:6-18:7>
references: <DefiningName "C" p1-p2-p3-p4.adb:4:6-4:7>
type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
expected type: None
Expr: <DottedName p1-p2-p3-p4.adb:18:11-18:15>
references: <DefiningName "C" p1-p2-p3.adb:4:6-4:7>
type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
expected type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
Expr: <Id "P3" p1-p2-p3-p4.adb:18:11-18:13>
references: <DefiningName "P3" p1-p2-p3.adb:2:11-2:13>
type: None
expected type: None
Expr: <Id "C" p1-p2-p3-p4.adb:18:14-18:15>
references: <DefiningName "C" p1-p2-p3.adb:4:6-4:7>
type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
expected type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>


Done.
2 changes: 2 additions & 0 deletions testsuite/tests/name_resolution/recursive_subunit/test.yaml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
driver: name-resolution
input_sources: [p1-p2.adb, p1-p2-p3.adb, p1-p2-p3-p4.adb]

0 comments on commit 8eac42d

Please sign in to comment.