diff options
Diffstat (limited to 'gcc/ada/exp_ch4.adb')
-rw-r--r-- | gcc/ada/exp_ch4.adb | 25 |
1 files changed, 25 insertions, 0 deletions
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index b0a65cf92da..605de764254 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -3565,6 +3565,31 @@ package body Exp_Ch4 is Set_Procedure_To_Call (N, RTE (RE_SS_Allocate)); end if; + -- In the case of an allocator for a simple storage pool, locate + -- and save a reference to the pool type's Allocate routine. + + elsif Present (Get_Rep_Pragma + (Etype (Pool), Name_Simple_Storage_Pool)) + then + declare + Alloc_Op : Entity_Id := Get_Name_Entity_Id (Name_Allocate); + Pool_Type : constant Entity_Id := Base_Type (Etype (Pool)); + + begin + while Present (Alloc_Op) loop + if Scope (Alloc_Op) = Scope (Pool_Type) + and then Present (First_Formal (Alloc_Op)) + and then Etype (First_Formal (Alloc_Op)) = Pool_Type + then + Set_Procedure_To_Call (N, Alloc_Op); + + exit; + end if; + + Alloc_Op := Homonym (Alloc_Op); + end loop; + end; + elsif Is_Class_Wide_Type (Etype (Pool)) then Set_Procedure_To_Call (N, RTE (RE_Allocate_Any)); |