summaryrefslogtreecommitdiff
path: root/gcc/ada/exp_ch4.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/ada/exp_ch4.adb')
-rw-r--r--gcc/ada/exp_ch4.adb25
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));