[Ada] Fix PR ada/112781 (1/2)
Checks
Commit Message
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 triggered by
this case; 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.
Tested on SPARC64/Linux, applied on the mainline and 13 branch.
2024-01-09 Eric Botcazou <ebotcazou@adacore.com>
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.
@@ -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
@@ -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);