https://gcc.gnu.org/g:da252eaaf495e29709aa0fc084ec1b2fbacc464e
commit r17-1333-gda252eaaf495e29709aa0fc084ec1b2fbacc464e Author: Eric Botcazou <[email protected]> Date: Wed May 20 19:19:42 2026 +0200 ada: Fix again internal error on abstract primitive with access result 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. Diff: --- 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 2911fba80fcc..157896bcf0e1 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 ca9826ddf8d8..18bcf5181fae 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);
