From: Eric Botcazou <[email protected]>
The previous fix was papering over the root cause, which is that the itype
built for the anonymous access result type of a derived subprogram is given
the subprogram itself as Scope, instead of the scope of the subprogram. The
incorrect code also temporarily sets the Scope of the subprogram to itself!
gcc/ada/ChangeLog:
* accessibility.adb (Type_Access_Level): Revert ealier change.
* sem_ch3.adb (Derive_Subprogram.Replace_Type): Set the Scope of
the new anonymous access type to the scope of the derived type.
Do not (temporarily) sets the Scope of the subprogram to itself.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/accessibility.adb | 15 +--------------
gcc/ada/sem_ch3.adb | 13 ++++++-------
2 files changed, 7 insertions(+), 21 deletions(-)
diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb
index 2911fba80fc..157896bcf0e 100644
--- a/gcc/ada/accessibility.adb
+++ b/gcc/ada/accessibility.adb
@@ -2759,20 +2759,7 @@ package body Accessibility is
return Scope_Depth (Standard_Standard);
end if;
- -- It is possible that the current scope is an aliased subprogram -
- -- this can happen when an abstract primitive from a root type is not
- -- not visible.
-
- if Is_Subprogram (Enclosing_Dynamic_Scope (Btyp))
- and then Present (Alias (Enclosing_Dynamic_Scope (Btyp)))
- then
- return Scope_Depth (Ultimate_Alias (Enclosing_Dynamic_Scope (Btyp)));
-
- -- Otherwise, simply use the enclosing dynamic scope
-
- else
- return Scope_Depth (Enclosing_Dynamic_Scope (Btyp));
- end if;
+ return Scope_Depth (Enclosing_Dynamic_Scope (Btyp));
end Type_Access_Level;
end Accessibility;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index ca9826ddf8d..18bcf5181fa 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -16609,7 +16609,7 @@ package body Sem_Ch3 is
procedure Replace_Type (Id, New_Id : Entity_Id) is
Id_Type : constant Entity_Id := Etype (Id);
- Par : constant Node_Id := Parent (Derived_Type);
+ Par : constant Node_Id := Parent (Derived_Type);
begin
-- When the type is an anonymous access type, create a new access
@@ -16641,11 +16641,11 @@ package body Sem_Ch3 is
then
Acc_Type := New_Copy (Id_Type);
Set_Etype (Acc_Type, Acc_Type);
- Set_Scope (Acc_Type, New_Subp);
+ Set_Scope (Acc_Type, Scope (Derived_Type));
-- Set size of anonymous access type. If we have an access
- -- to an unconstrained array, this is a fat pointer, so it
- -- is sizes at twice addtress size.
+ -- to an unconstrained array, this is a fat pointer, so its
+ -- size is twice the address size.
if Is_Array_Type (Desig_Typ)
and then not Is_Constrained (Desig_Typ)
@@ -16658,17 +16658,16 @@ package body Sem_Ch3 is
Init_Size (Acc_Type, System_Address_Size);
end if;
- -- Set remaining characterstics of anonymous access type
+ -- Set remaining characteristics of anonymous access type
Reinit_Alignment (Acc_Type);
Set_Directly_Designated_Type (Acc_Type, Derived_Type);
Set_Etype (New_Id, Acc_Type);
- Set_Scope (New_Id, New_Subp);
-- Create a reference to it
- Build_Itype_Reference (Acc_Type, Parent (Derived_Type));
+ Build_Itype_Reference (Acc_Type, Par);
else
Set_Etype (New_Id, Id_Type);
--
2.53.0
