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

[Ada] AI12-0207 Convention of anonymous access types

Browse Source 
2020-06-05  Arnaud Charlet  <charlet@adacore.com>

gcc/ada/

	* sem_prag.adb (Set_Convention_From_Pragma): Set the convention
	of anonymous access array components.
This commit is contained in:
Arnaud Charlet 2020-01-31 15:53:42 -05:00 committed by Pierre-Marie de Rodat
parent 632d4a43d7
commit a9969d7feb
1 changed files with 29 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
gcc/ada/sem_prag.adb
View File

@ -8020,26 +8020,38 @@ package body Sem_Prag is
-- For the case of a record base type, also set the convention of -- For the case of a record base type, also set the convention of
-- any anonymous access types declared in the record which do not -- any anonymous access types declared in the record which do not
-- currently have a specified convention. -- currently have a specified convention.
-- Similarly for an array base type and anonymous access types
-- components.
if Is_Record_Type (E) and then Is_Base_Type (E) then if Is_Base_Type (E) then
declare if Is_Record_Type (E) then
Comp : Node_Id; declare
Comp : Node_Id;
begin begin
Comp := First_Component (E); Comp := First_Component (E);
while Present (Comp) loop while Present (Comp) loop
if Present (Etype (Comp)) if Present (Etype (Comp))
and then Ekind_In (Etype (Comp), and then
E_Anonymous_Access_Type, Ekind_In (Etype (Comp),
E_Anonymous_Access_Subprogram_Type) E_Anonymous_Access_Type,
and then not Has_Convention_Pragma (Comp) E_Anonymous_Access_Subprogram_Type)
then and then not Has_Convention_Pragma (Comp)
Set_Convention (Comp, C); then
end if; Set_Convention (Comp, C);
end if;
Next_Component (Comp); Next_Component (Comp);
end loop; end loop;
end; end;
elsif Is_Array_Type (E)
and then Ekind_In (Component_Type (E),
E_Anonymous_Access_Type,
E_Anonymous_Access_Subprogram_Type)
then
Set_Convention (Designated_Type (Component_Type (E)), C);
end if;
end if; end if;
-- Deal with incomplete/private type case, where underlying type -- Deal with incomplete/private type case, where underlying type