From add6d89eaed4070803882b9a0b643d963ca8d80a Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Thu, 18 Apr 2024 09:54:22 +0000 Subject: ada: Storage_Error in indirect call to function returning limited type At runtime the code generated by the compiler reports the exception Storage_Error in an indirect call through an access-to-subprogram variable that references a function returning a limited tagged type object. gcc/ada/ * sem_ch6.adb (Might_Need_BIP_Task_Actuals): Add support for access-to-subprogram parameter types. * exp_ch6.adb (Add_Task_Actuals_To_Build_In_Place_Call): Add dummy BIP parameters to access-to-subprogram types that may reference a function that has BIP parameters. --- gcc/ada/sem_ch6.adb | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) (limited to 'gcc/ada/sem_ch6.adb') diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index ca40b54..50dac5c 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -8663,9 +8663,12 @@ package body Sem_Ch6 is -- Determines if E has its extra formals function Might_Need_BIP_Task_Actuals (E : Entity_Id) return Boolean; - -- Determines if E is a dispatching primitive returning a limited tagged - -- type object since some descendant might return an object with tasks - -- (and therefore need the BIP task extra actuals). + -- Determines if E is a function or an access to a function returning a + -- limited tagged type object. On dispatching primitives this predicate + -- is used to determine if some descendant of the function might return + -- an object with tasks (and therefore need the BIP task extra actuals). + -- On access-to-subprogram types it is used to determine if the target + -- function might return an object with tasks. function Needs_Accessibility_Check_Extra (E : Entity_Id; @@ -8786,9 +8789,8 @@ package body Sem_Ch6 is Func_Typ := Root_Type (Underlying_Type (Etype (Subp_Id))); - return Ekind (Subp_Id) = E_Function + return Ekind (Subp_Id) in E_Function | E_Subprogram_Type and then not Has_Foreign_Convention (Func_Typ) - and then Is_Dispatching_Operation (Subp_Id) and then Is_Tagged_Type (Func_Typ) and then Is_Limited_Type (Func_Typ) and then not Has_Aspect (Func_Typ, Aspect_No_Task_Parts); -- cgit v1.1