diff options
author | Javier Miranda <miranda@adacore.com> | 2024-04-18 09:54:22 +0000 |
---|---|---|
committer | Eric Botcazou <ebotcazou@adacore.com> | 2024-06-10 11:50:40 +0200 |
commit | a1bec0455fb6f871bbc2c80d6e19c90deebbf824 (patch) | |
tree | 6121a43bafcba3a3eaabf5da5285fb9bd3255bf1 | |
parent | 6bd8a3a7a8943184b168888321f626d98045316c (diff) | |
download | gcc-a1bec0455fb6f871bbc2c80d6e19c90deebbf824.zip gcc-a1bec0455fb6f871bbc2c80d6e19c90deebbf824.tar.gz gcc-a1bec0455fb6f871bbc2c80d6e19c90deebbf824.tar.bz2 |
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.
-rw-r--r-- | gcc/ada/exp_ch6.adb | 11 | ||||
-rw-r--r-- | gcc/ada/sem_ch6.adb | 12 |
2 files changed, 15 insertions, 8 deletions
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index ad56cfd..621be2d7 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -646,15 +646,20 @@ package body Exp_Ch6 is Master_Formal : Node_Id; begin + pragma Assert (Ekind (Function_Id) in E_Function + | E_Subprogram_Type); + -- No such extra parameters are needed if there are no tasks if not Needs_BIP_Task_Actuals (Function_Id) then -- However we must add dummy extra actuals if the function is - -- a dispatching operation that inherited these extra formals. + -- a dispatching operation that inherited these extra formals + -- or an access-to-subprogram type that requires these extra + -- actuals. - if Is_Dispatching_Operation (Function_Id) - and then Has_BIP_Extra_Formal (Function_Id, BIP_Task_Master) + if Has_BIP_Extra_Formal (Function_Id, BIP_Task_Master, + Must_Be_Frozen => False) then Master_Formal := Build_In_Place_Formal (Function_Id, BIP_Task_Master); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index fb43b04..4f33e74 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -8660,9 +8660,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; @@ -8783,9 +8786,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); |