diff options
author | Gary Dismukes <dismukes@adacore.com> | 2018-07-16 14:09:53 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2018-07-16 14:09:53 +0000 |
commit | b3181992f587d6d7de62c21ae93fb37d68f8d265 (patch) | |
tree | 8067b78c00a8362654801c63f876a8a23fb7a3b5 | |
parent | d3bbfc593690e307c5c41885ebec8a7ecabb1a41 (diff) | |
download | gcc-b3181992f587d6d7de62c21ae93fb37d68f8d265.zip gcc-b3181992f587d6d7de62c21ae93fb37d68f8d265.tar.gz gcc-b3181992f587d6d7de62c21ae93fb37d68f8d265.tar.bz2 |
[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 <dismukes@adacore.com>
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
-rw-r--r-- | gcc/ada/ChangeLog | 11 | ||||
-rw-r--r-- | gcc/ada/exp_ch4.adb | 6 | ||||
-rw-r--r-- | gcc/ada/libgnat/s-elaall.adb | 2 | ||||
-rw-r--r-- | 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 f41cf4d..19e2c44 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,16 @@ 2018-07-16 Gary Dismukes <dismukes@adacore.com> + * 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 <dismukes@adacore.com> + * sem_eval.adb: Fix spelling for compile-time-known. 2018-07-16 Hristian Kirtchev <kirtchev@adacore.com> diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index c29ba76..222ca19 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 78707ce..1c4517a 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 d561ff8..cbe4d69 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; |