This is the mail archive of the mailing list for the GCC project.

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[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);


   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)
      type Local_Acc is access Rec;

      Local_Ptr : Local_Acc;

      if Use_Global_Allocator then
         Ptr := new Rec;  -- Raise Storage_Error if after elaboration
         Ptr.Int := 1;
         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;

      when Storage_Error =>
         if During_Elaboration then
            raise Program_Error;  -- No exception expected: FAIL
            null;                 -- Expected Storage_Error: PASS
         end if;
      when others =>
         raise Program_Error;  -- Unexpected exception: FAIL
   end Allocate;

   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
     (Use_Global_Allocator => True,
      During_Elaboration   => False);

     (Use_Global_Allocator => False,
      During_Elaboration   => False);
end Alloc_Restriction_Main;

Tested on x86_64-pc-linux-gnu, committed on trunk

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/ (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.
--- gcc/ada/exp_ch4.adb
+++ 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)
          Insert_Action (N,

--- gcc/ada/libgnat/s-elaall.adb
+++ gcc/ada/libgnat/s-elaall.adb
@@ -45,7 +45,7 @@ package body System.Elaboration_Allocators is
    procedure Check_Standard_Allocator is
       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;

--- gcc/ada/libgnat/
+++ gcc/ada/libgnat/
@@ -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;

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]