From b3181992f587d6d7de62c21ae93fb37d68f8d265 Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Mon, 16 Jul 2018 14:09:53 +0000 Subject: [PATCH] [Ada] Violation of No_Standard_Allocators_After_Elaboration not detected The compiler fails to generate a call to detect allocators executed after elaboration in cases where the allocator is associated with Global_Pool_Object. The fix is to test for this associated storage pool as part of the condition for generating a call to System.Elaboration_Allocators.Check_Standard_Alloctor. Also, the exception Storage_Error is now generated instead of Program_Error for such a run-time violation, as required by the Ada RM in D.7. The following test must compile and execute quietly: -- Put the pragma in gnat.adc: pragma Restrictions (No_Standard_Allocators_After_Elaboration); package Pkg_With_Allocators is type Priv is private; procedure Allocate (Use_Global_Allocator : Boolean; During_Elaboration : Boolean); private type Rec is record Int : Integer; end record; type Priv is access Rec; end Pkg_With_Allocators; package body Pkg_With_Allocators is Ptr : Priv; procedure Allocate (Use_Global_Allocator : Boolean; During_Elaboration : Boolean) is type Local_Acc is access Rec; Local_Ptr : Local_Acc; begin if Use_Global_Allocator then Ptr := new Rec; -- Raise Storage_Error if after elaboration Ptr.Int := 1; else Local_Ptr := new Rec; -- Raise Storage_Error if after elaboration Local_Ptr.Int := 1; end if; if not During_Elaboration then raise Program_Error; -- No earlier exception: FAIL end if; exception when Storage_Error => if During_Elaboration then raise Program_Error; -- No exception expected: FAIL else null; -- Expected Storage_Error: PASS end if; when others => raise Program_Error; -- Unexpected exception: FAIL end Allocate; begin Allocate (Use_Global_Allocator => True, During_Elaboration => True); Allocate (Use_Global_Allocator => False, During_Elaboration => True); end Pkg_With_Allocators; with Pkg_With_Allocators; procedure Alloc_Restriction_Main is begin Pkg_With_Allocators.Allocate (Use_Global_Allocator => True, During_Elaboration => False); Pkg_With_Allocators.Allocate (Use_Global_Allocator => False, During_Elaboration => False); end Alloc_Restriction_Main; 2018-07-16 Gary Dismukes gcc/ada/ * exp_ch4.adb (Expand_N_Allocator): Test for Storage_Pool being RTE in addition to the existing test for no Storage_Pool as a condition enabling generation of the call to Check_Standard_Allocator when the restriction No_Standard_Allocators_After_Elaboration is active. * libgnat/s-elaall.ads (Check_Standard_Allocator): Correct comment to say that Storage_Error will be raised (rather than Program_Error). * libgnat/s-elaall.adb (Check_Standard_Allocator): Raise Storage_Error rather than Program_Error when Elaboration_In_Progress is False. From-SVN: r262700 --- gcc/ada/ChangeLog | 11 +++++++++++ gcc/ada/exp_ch4.adb | 6 ++++-- gcc/ada/libgnat/s-elaall.adb | 2 +- gcc/ada/libgnat/s-elaall.ads | 2 +- 4 files changed, 17 insertions(+), 4 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f41cf4d1a3a..19e2c44c50b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2018-07-16 Gary Dismukes + + * exp_ch4.adb (Expand_N_Allocator): Test for Storage_Pool being RTE in + addition to the existing test for no Storage_Pool as a condition + enabling generation of the call to Check_Standard_Allocator when the + restriction No_Standard_Allocators_After_Elaboration is active. + * libgnat/s-elaall.ads (Check_Standard_Allocator): Correct comment to + say that Storage_Error will be raised (rather than Program_Error). + * libgnat/s-elaall.adb (Check_Standard_Allocator): Raise Storage_Error + rather than Program_Error when Elaboration_In_Progress is False. + 2018-07-16 Gary Dismukes * sem_eval.adb: Fix spelling for compile-time-known. diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index c29ba76f113..222ca19706d 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -4561,12 +4561,14 @@ package body Exp_Ch4 is end if; end if; - -- If no storage pool has been specified and we have the restriction + -- If no storage pool has been specified, or the storage pool + -- is System.Pool_Global.Global_Pool_Object, and the restriction -- No_Standard_Allocators_After_Elaboration is present, then generate -- a call to Elaboration_Allocators.Check_Standard_Allocator. if Nkind (N) = N_Allocator - and then No (Storage_Pool (N)) + and then (No (Storage_Pool (N)) + or else Is_RTE (Storage_Pool (N), RE_Global_Pool_Object)) and then Restriction_Active (No_Standard_Allocators_After_Elaboration) then Insert_Action (N, diff --git a/gcc/ada/libgnat/s-elaall.adb b/gcc/ada/libgnat/s-elaall.adb index 78707ceb43c..1c4517a5b3b 100644 --- a/gcc/ada/libgnat/s-elaall.adb +++ b/gcc/ada/libgnat/s-elaall.adb @@ -45,7 +45,7 @@ package body System.Elaboration_Allocators is procedure Check_Standard_Allocator is begin if not Elaboration_In_Progress then - raise Program_Error with + raise Storage_Error with "standard allocator after elaboration is complete is not allowed " & "(No_Standard_Allocators_After_Elaboration restriction active)"; end if; diff --git a/gcc/ada/libgnat/s-elaall.ads b/gcc/ada/libgnat/s-elaall.ads index d561ff842a0..cbe4d693ea8 100644 --- a/gcc/ada/libgnat/s-elaall.ads +++ b/gcc/ada/libgnat/s-elaall.ads @@ -51,7 +51,7 @@ package System.Elaboration_Allocators is procedure Check_Standard_Allocator; -- Called as part of every allocator in a program for which the restriction -- No_Standard_Allocators_After_Elaboration is active. This will raise an - -- exception (Program_Error with an appropriate message) if it is called + -- exception (Storage_Error with an appropriate message) if it is called -- after the call to Mark_End_Of_Elaboration. end System.Elaboration_Allocators; -- 2.30.2