[Ada] Violation of No_Standard_Allocators_After_Elaboration not detected

[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