From 01264f72d9c90212dc62681f4fd6cbd16f78263d Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Mon, 20 Apr 2020 15:17:05 -0400 Subject: [PATCH] [Ada] Crash in tagged type constructor with task components 2020-06-18 Javier Miranda gcc/ada/ * exp_disp.adb (Expand_Dispatching_Call): Add missing decoration of attribute Extra_Accessibility_Of_Result. * freeze.adb (Check_Extra_Formals): No check required if expansion is disabled; Adding check on Extra_Accessibilty_Of_Result. (Freeze_Subprogram): Fix decoration of Extra_Accessibility_Of_Result. * sem_ch3.adb (Derive_Subprogram): Fix decoration of Extra_Accessibility_Of_Result --- gcc/ada/exp_disp.adb | 14 ++++++++++++++ gcc/ada/freeze.adb | 27 +++++++++++++++++++++++---- gcc/ada/sem_ch3.adb | 5 +++++ 3 files changed, 42 insertions(+), 4 deletions(-) diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 1585998..65d5b2a 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -1085,12 +1085,26 @@ package body Exp_Disp is Set_Extra_Formal (Last_Formal, New_Formal); Set_Extra_Formals (Subp_Typ, New_Formal); + if Ekind (Subp) = E_Function + and then Present (Extra_Accessibility_Of_Result (Subp)) + and then Extra_Accessibility_Of_Result (Subp) = Old_Formal + then + Set_Extra_Accessibility_Of_Result (Subp_Typ, New_Formal); + end if; + Old_Formal := Extra_Formal (Old_Formal); while Present (Old_Formal) loop Set_Extra_Formal (New_Formal, New_Copy (Old_Formal)); New_Formal := Extra_Formal (New_Formal); Set_Scope (New_Formal, Subp_Typ); + if Ekind (Subp) = E_Function + and then Present (Extra_Accessibility_Of_Result (Subp)) + and then Extra_Accessibility_Of_Result (Subp) = Old_Formal + then + Set_Extra_Accessibility_Of_Result (Subp_Typ, New_Formal); + end if; + Old_Formal := Extra_Formal (Old_Formal); end loop; end if; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 4862c7d..57b4894 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -8718,6 +8718,14 @@ package body Freeze is Has_Extra_Formals : Boolean := False; begin + -- No check required if expansion is disabled because extra + -- formals are only generated when we are generating code. + -- See Create_Extra_Formals. + + if not Expander_Active then + return True; + end if; + -- Check attribute Extra_Formal: if available it must be set only -- in the last formal of E @@ -8735,6 +8743,15 @@ package body Freeze is Next_Formal (Formal); end loop; + -- Check attribute Extra_Accessibility_Of_Result + + if Ekind_In (E, E_Function, E_Subprogram_Type) + and then Needs_Result_Accessibility_Level (E) + and then No (Extra_Accessibility_Of_Result (E)) + then + return False; + end if; + -- Check attribute Extra_Formals: if E has extra formals then this -- attribute must must point to the first extra formal of E. @@ -8897,14 +8914,16 @@ package body Freeze is -- still unset (and must be set now). if Present (Alias (E)) + and then Is_Frozen (Ultimate_Alias (E)) and then Present (Extra_Formals (Ultimate_Alias (E))) and then Last_Formal (Ultimate_Alias (E)) = Last_Formal (E) then - pragma Assert (Is_Frozen (Ultimate_Alias (E))); - pragma Assert (No (First_Formal (Ultimate_Alias (E))) - or else - Present (Extra_Formal (Last_Formal (Ultimate_Alias (E))))); Set_Extra_Formals (E, Extra_Formals (Ultimate_Alias (E))); + + if Ekind (E) = E_Function then + Set_Extra_Accessibility_Of_Result (E, + Extra_Accessibility_Of_Result (Ultimate_Alias (E))); + end if; else Create_Extra_Formals (E); end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 6e0cfe2..78de388 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -15563,6 +15563,11 @@ package body Sem_Ch3 is Set_Extra_Formals (New_Subp, Extra_Formals (Parent_Subp)); + if Ekind (New_Subp) = E_Function then + Set_Extra_Accessibility_Of_Result (New_Subp, + Extra_Accessibility_Of_Result (Parent_Subp)); + end if; + -- If this derivation corresponds to a tagged generic actual, then -- primitive operations rename those of the actual. Otherwise the -- primitive operations rename those of the parent type, If the parent -- 2.7.4