OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[Ada] Crash in tagged type constructor with task components

Browse Source 
2020-06-18  Javier Miranda  <miranda@adacore.com>

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
This commit is contained in:
Javier Miranda 2020-04-20 15:17:05 -04:00 committed by Pierre-Marie de Rodat
parent 52531a6203
commit 01264f72d9
3 changed files with 42 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/ada/exp_disp.adb
View File

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

27
gcc/ada/freeze.adb
View File

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

5
gcc/ada/sem_ch3.adb
View File

@ -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