From: Eric Botcazou <ebotcazou@adacore.com>
Date: Wed, 20 May 2026 17:19:42 +0000 (+0200)
Subject: ada: Fix again internal error on abstract primitive with access result
X-Git-Url: http://git.ipfire.org/gitweb/index.cgi?a=commitdiff_plain;h=da252eaaf495e29709aa0fc084ec1b2fbacc464e;p=thirdparty%2Fgcc.git

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 --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);