From 2aa1a9205e3e9581e771c7d02e35fd03bff9fce3 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Sat, 19 Aug 2023 16:50:42 +0000 Subject: ada: Crash on creation of extra formals on type extension The compiler blows up processing an overriding dispatching function of a derived tagged type that returns a private tagged type that has an access type discriminant. gcc/ada/ * accessibility.ads (Needs_Result_Accessibility_Extra_Formal): New subprogram. * accessibility.adb (Needs_Result_Accessibility_Level_Param): New subprogram. (Needs_Result_Accessibility_Extra_Formal): New subprogram, temporarily keep the previous behavior of the frontend. * sem_ch6.adb (Create_Extra_Formals): Replace occurrences of function Needs_Result_Accessibility_Level_Param by calls to function Needs_Result_Accessibility_Extra_Formal. (Extra_Formals_OK): Ditto. --- gcc/ada/sem_ch6.adb | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'gcc/ada/sem_ch6.adb') diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 53011f4..297371a 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -9139,13 +9139,13 @@ package body Sem_Ch6 is begin Ada_Version := Ada_2022; - if Needs_Result_Accessibility_Level (Ref_E) + if Needs_Result_Accessibility_Extra_Formal (Ref_E) or else (Present (Parent_Subp) - and then Needs_Result_Accessibility_Level (Parent_Subp)) + and then Needs_Result_Accessibility_Extra_Formal (Parent_Subp)) or else (Present (Alias_Subp) - and then Needs_Result_Accessibility_Level (Alias_Subp)) + and then Needs_Result_Accessibility_Extra_Formal (Alias_Subp)) then Set_Extra_Accessibility_Of_Result (E, Add_Extra_Formal (E, Standard_Natural, E, "L")); @@ -9694,7 +9694,7 @@ package body Sem_Ch6 is -- Check attribute Extra_Accessibility_Of_Result if Ekind (E) in E_Function | E_Subprogram_Type - and then Needs_Result_Accessibility_Level (E) + and then Needs_Result_Accessibility_Extra_Formal (E) and then No (Extra_Accessibility_Of_Result (E)) then return False; -- cgit v1.1