[gcc r14-7031] Fix internal error on function call returning extension of limited interface

[Eric Botcazou]

https://gcc.gnu.org/g:436ce7a3510000e0939094592fc12353e17527f1

commit r14-7031-g436ce7a3510000e0939094592fc12353e17527f1
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Tue Jan 9 10:46:23 2024 +0100

    Fix internal error on function call returning extension of limited interface
    
    This is a regression present on the mainline and 13 branch, in the form of a
    series of internal errors (3) on a function call returning the extension of
    a limited interface.
    
    This is only a partial fix for the first two assertion failures; the third
    one is the most problematic and will be dealt with separately.
    
    The first issue is in Instantiate_Type, where we use Base_Type in a specific
    case to compute the ancestor of a derived type, which will later trigger the
    assertion on line 16960 of sem_ch3.adb since Parent_Base and Generic_Actual
    are the same node.  This is changed to use Etype like in other cases around.
    
    The second issue is an unprotected use of Designated_Type on type T in
    Analyze_Explicit_Dereference, while another use in an equivalent context
    is guarded by Is_Access_Type a few lines above.
    
    gcc/ada
            PR ada/112781
            * sem_ch12.adb (Instantiate_Type): Use Etype instead of Base_Type
            consistently to retrieve the ancestor for a derived type.
            * sem_ch4.adb (Analyze_Explicit_Dereference): Test Is_Access_Type
            consistently before accessing Designated_Type.

Diff:
---
 gcc/ada/sem_ch12.adb | 3 +--
 gcc/ada/sem_ch4.adb  | 4 +++-
 2 files changed, 4 insertions(+), 3 deletions(-)

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index bfb400f5642..d2285082f97 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -13522,8 +13522,7 @@ package body Sem_Ch12 is
                Ancestor := Get_Instance_Of (Ancestor);
 
             else
-               Ancestor :=
-                 Get_Instance_Of (Base_Type (Get_Instance_Of (A_Gen_T)));
+               Ancestor := Get_Instance_Of (Etype (Get_Instance_Of (A_Gen_T)));
             end if;
 
          --  Check whether parent is a previous formal of the current generic
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 64aa9a84e60..85ae282dc37 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -2304,7 +2304,9 @@ package body Sem_Ch4 is
             while Present (It.Nam) loop
                T := It.Typ;
 
-               if No (First_Formal (Base_Type (Designated_Type (T)))) then
+               if Is_Access_Type (T)
+                 and then No (First_Formal (Base_Type (Designated_Type (T))))
+               then
                   Set_Etype (P, T);
                else
                   Remove_Interp (I);