aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorEd Schonberg <schonberg@adacore.com>2020-05-18 11:25:32 +0200
committerPierre-Marie de Rodat <derodat@adacore.com>2020-07-08 10:55:52 -0400
commit4b5838e086b0e38f3398268b001b936b600f2e5b (patch)
tree10245198f5dd443eafea08ac6876270e22038da9 /gcc
parent6091c2e0fa1836c6607562d273a529db5535c3d8 (diff)
downloadgcc-4b5838e086b0e38f3398268b001b936b600f2e5b.zip
gcc-4b5838e086b0e38f3398268b001b936b600f2e5b.tar.gz
gcc-4b5838e086b0e38f3398268b001b936b600f2e5b.tar.bz2
[Ada] Update entities on class-wide condition function creation
gcc/ada/ * sem_util.adb (Build_Class_Wide_Clone_Body): Update entities to refer to the right spec.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/sem_util.adb23
1 files changed, 22 insertions, 1 deletions
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 8dd9e18..89b6452 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -1510,17 +1510,38 @@ package body Sem_Util is
Loc : constant Source_Ptr := Sloc (Bod);
Clone_Id : constant Entity_Id := Class_Wide_Clone (Spec_Id);
Clone_Body : Node_Id;
+ Assoc_List : constant Elist_Id := New_Elmt_List;
begin
-- The declaration of the class-wide clone was created when the
-- corresponding class-wide condition was analyzed.
+ -- The body of the original condition may contain references to
+ -- the formals of Spec_Id. In the body of the classwide clone,
+ -- these must be replaced with the corresponding formals of
+ -- the clone.
+
+ declare
+ Spec_Formal_Id : Entity_Id := First_Formal (Spec_Id);
+ Clone_Formal_Id : Entity_Id := First_Formal (Clone_Id);
+ begin
+ while Present (Spec_Formal_Id) loop
+ Append_Elmt (Spec_Formal_Id, Assoc_List);
+ Append_Elmt (Clone_Formal_Id, Assoc_List);
+
+ Next_Formal (Spec_Formal_Id);
+ Next_Formal (Clone_Formal_Id);
+ end loop;
+ end;
+
Clone_Body :=
Make_Subprogram_Body (Loc,
Specification =>
Copy_Subprogram_Spec (Parent (Clone_Id)),
Declarations => Declarations (Bod),
- Handled_Statement_Sequence => Handled_Statement_Sequence (Bod));
+ Handled_Statement_Sequence =>
+ New_Copy_Tree (Handled_Statement_Sequence (Bod),
+ Map => Assoc_List));
-- The new operation is internal and overriding indicators do not apply
-- (the original primitive may have carried one).