This implements the final definition of the Ada 2012 restriction
No_Standard_Allocators_After_Elaboration. There are two static
cases. First appearence in task body, this one we already had
before (compiled with -gnatj55 -gnatld7)
1. procedure Pmain2 is
2. type P is access all Integer;
3. PV : P;
4. task X;
5. task body X is
6. begin
7. PV := new Integer;
|
>>> violation of restriction
"No_Standard_Allocators_After_Elaboration"
at gnat.adc:1
8. end;
9. begin
10. null;
11. end;
Second, also a static case, appearence in a parameterless
library level procedure (same switches)
1. procedure Pmain is
2. type R is access all Integer;
3. RV : R;
4. begin
5. RV := new Integer;
|
>>> violation of restriction
"No_Standard_Allocators_After_Elaboration"
at gnat.adc:1
6. end;
Finally the dynamic case tested at run-time:
1. with Allocate_After_Elab;
2. procedure Allocate_After_Elab_Test is
3. begin
4. Allocate_After_Elab (42);
5. end Allocate_After_Elab_Test;
1. with Ada.Text_IO;
2. procedure Allocate_After_Elab (X : Integer) is
3. type Int_Ptr_Type is access Integer;
4. My_Int_Ptr : Int_Ptr_Type;
5. begin
6. My_Int_Ptr := new Integer'(X);
7. Ada.Text_IO.Put_Line ("Have used allocator");
8. end Allocate_After_Elab;
If we run Allocate_After_Elab_Test, we get:
raised PROGRAM_ERROR : standard allocator after elaboration is complete is not
allowed
(No_Standard_Allocators_After_Elaboration restriction active)
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-07-18 Robert Dewar <de...@adacore.com>
* gcc-interface/Make-lang.in: Add entry for s-elaall.o
* bcheck.adb (Check_Consistent_Restrictions):
Remove obsolete code checking for violation of
No_Standard_Allocators_After_Elaboration (main program)
* bindgen.adb (Gen_Adainit): Handle
No_Standard_Allocators_After_Elaboration
(Gen_Output_File_Ada): ditto.
* exp_ch4.adb (Expand_N_Allocator): Handle
No_Standard_Allocators_After_Elaboration.
* Makefile.rtl: Add entry for s-elaall
* rtsfind.ads: Add entry for Check_Standard_Allocator.
* s-elaall.ads, s-elaall.adb: New files.
* sem_ch4.adb (Analyze_Allocator): Handle
No_Standard_Allocators_After_Elaboration.
Index: bindgen.adb
===================================================================
--- bindgen.adb (revision 212735)
+++ bindgen.adb (working copy)
@@ -739,8 +739,8 @@
if Dispatching_Domains_Used then
WBI (" procedure Freeze_Dispatching_Domains;");
WBI (" pragma Import");
- WBI (" (Ada, Freeze_Dispatching_Domains, " &
- """__gnat_freeze_dispatching_domains"");");
+ WBI (" (Ada, Freeze_Dispatching_Domains, "
+ & """__gnat_freeze_dispatching_domains"");");
end if;
WBI (" begin");
@@ -749,6 +749,18 @@
WBI (" end if;");
WBI (" Is_Elaborated := True;");
+ -- Call System.Elaboration_Allocators.Mark_Start_Of_Elaboration if
+ -- restriction No_Standard_Allocators_After_Elaboration is active.
+
+ if Cumulative_Restrictions.Set
+ (No_Standard_Allocators_After_Elaboration)
+ then
+ WBI (" System.Elaboration_Allocators."
+ & "Mark_Start_Of_Elaboration;");
+ end if;
+
+ -- Generate assignments to initialize globals
+
Set_String (" Main_Priority := ");
Set_Int (Main_Priority);
Set_Char (';');
@@ -996,6 +1008,15 @@
Gen_Elab_Calls;
+ -- Call System.Elaboration_Allocators.Mark_Start_Of_Elaboration if
+ -- restriction No_Standard_Allocators_After_Elaboration is active.
+
+ if Cumulative_Restrictions.Set
+ (No_Standard_Allocators_After_Elaboration)
+ then
+ WBI (" System.Elaboration_Allocators.Mark_End_Of_Elaboration;");
+ end if;
+
-- From this point, no new dispatching domain can be created.
if Dispatching_Domains_Used then
@@ -2482,10 +2503,23 @@
WBI ("with System.Restrictions;");
end if;
+ -- Generate with of Ada.Exceptions if needs library finalization
+
if Needs_Library_Finalization then
WBI ("with Ada.Exceptions;");
end if;
+ -- Generate with of System.Elaboration_Allocators if the restriction
+ -- No_Standard_Allocators_After_Elaboration was present.
+
+ if Cumulative_Restrictions.Set
+ (No_Standard_Allocators_After_Elaboration)
+ then
+ WBI ("with System.Elaboration_Allocators;");
+ end if;
+
+ -- Generate start of package body
+
WBI ("");
WBI ("package body " & Ada_Main & " is");
WBI (" pragma Warnings (Off);");
Index: rtsfind.ads
===================================================================
--- rtsfind.ads (revision 212725)
+++ rtsfind.ads (working copy)
@@ -241,6 +241,7 @@
System_Dim,
System_DSA_Services,
System_DSA_Types,
+ System_Elaboration_Allocators,
System_Exception_Table,
System_Exceptions_Debug,
System_Exn_Int,
@@ -856,6 +857,8 @@
RE_Any_Container_Ptr, -- System.DSA_Types
+ RE_Check_Standard_Allocator, -- System.Elaboration_Allocators
+
RE_Register_Exception, -- System.Exception_Table
RE_Local_Raise, -- System.Exceptions_Debug
@@ -2141,6 +2144,8 @@
RE_Any_Container_Ptr => System_DSA_Types,
+ RE_Check_Standard_Allocator => System_Elaboration_Allocators,
+
RE_Register_Exception => System_Exception_Table,
RE_Local_Raise => System_Exceptions_Debug,
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb (revision 212728)
+++ exp_ch4.adb (working copy)
@@ -4490,6 +4490,20 @@
end if;
end if;
+ -- If no storage pool has been specified and we have 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 Restriction_Active (No_Standard_Allocators_After_Elaboration)
+ then
+ Insert_Action (N,
+ Make_Procedure_Call_Statement (Loc,
+ Name =>
+ New_Occurrence_Of (RTE (RE_Check_Standard_Allocator), Loc)));
+ end if;
+
-- Handle case of qualified expression (other than optimization above)
-- First apply constraint checks, because the bounds or discriminants
-- in the aggregate might not match the subtype mark in the allocator.
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 212735)
+++ sem_ch4.adb (working copy)
@@ -400,6 +400,7 @@
Type_Id : Entity_Id;
P : Node_Id;
C : Node_Id;
+ Onode : Node_Id;
begin
Check_SPARK_Restriction ("allocator is not allowed", N);
@@ -420,33 +421,40 @@
P := Parent (C);
while Present (P) loop
- -- In both cases we need a handled sequence of statements, where
- -- the occurrence of the allocator is within the statements.
+ -- For the task case we need a handled sequence of statements,
+ -- where the occurrence of the allocator is within the statements
+ -- and the parent is a task body
if Nkind (P) = N_Handled_Sequence_Of_Statements
and then Is_List_Member (C)
and then List_Containing (C) = Statements (P)
then
+ Onode := Original_Node (Parent (P));
+
-- Check for allocator within task body, this is a definite
-- violation of No_Allocators_After_Elaboration we can detect
-- at compile time.
- if Nkind (Original_Node (Parent (P))) = N_Task_Body then
+ if Nkind (Onode) = N_Task_Body then
Check_Restriction
(No_Standard_Allocators_After_Elaboration, N);
exit;
end if;
+ end if;
- -- The other case is appearance in a subprogram body. This may
- -- be a violation if this is a library level subprogram, and it
- -- turns out to be used as the main program, but only the
- -- binder knows that, so just record the occurrence.
+ -- The other case is appearance in a subprogram body. This is
+ -- a violation if this is a library level subprogram with no
+ -- parameters. Note that this is now a static error even if the
+ -- subprogram is not the main program (this is a change, in an
+ -- earlier version only the main program was affected, and the
+ -- check had to be done in the binder.
- if Nkind (Original_Node (Parent (P))) = N_Subprogram_Body
- and then Nkind (Parent (Parent (P))) = N_Compilation_Unit
- then
- Set_Has_Allocator (Current_Sem_Unit);
- end if;
+ if Nkind (P) = N_Subprogram_Body
+ and then Nkind (Parent (P)) = N_Compilation_Unit
+ and then No (Parameter_Specifications (Specification (P)))
+ then
+ Check_Restriction
+ (No_Standard_Allocators_After_Elaboration, N);
end if;
C := P;
Index: s-elaall.adb
===================================================================
--- s-elaall.adb (revision 0)
+++ s-elaall.adb (revision 0)
@@ -0,0 +1,72 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . E L A B O R A T I O N _ A L L O C A T O R S --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2014, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+package body System.Elaboration_Allocators is
+
+ Elaboration_In_Progress : Boolean;
+ pragma Atomic (Elaboration_In_Progress);
+ -- Flag to show if elaboration is active. We don't attempt to initialize
+ -- this because we want to be sure it gets reset if we are in a multiple
+ -- elaboration situation of some kind. Make it atomic to prevent race
+ -- conditions of any kind (not clearly necessary, but harmless!)
+
+ ------------------------------
+ -- Check_Standard_Allocator --
+ ------------------------------
+
+ procedure Check_Standard_Allocator is
+ begin
+ if not Elaboration_In_Progress then
+ raise Program_Error with
+ "standard allocator after elaboration is complete is not allowed "
+ & "(No_Standard_Allocators_After_Elaboration restriction active)";
+ end if;
+ end Check_Standard_Allocator;
+
+ -----------------------------
+ -- Mark_End_Of_Elaboration --
+ -----------------------------
+
+ procedure Mark_End_Of_Elaboration is
+ begin
+ Elaboration_In_Progress := False;
+ end Mark_End_Of_Elaboration;
+
+ -------------------------------
+ -- Mark_Start_Of_Elaboration --
+ -------------------------------
+
+ procedure Mark_Start_Of_Elaboration is
+ begin
+ Elaboration_In_Progress := True;
+ end Mark_Start_Of_Elaboration;
+
+end System.Elaboration_Allocators;
Index: s-elaall.ads
===================================================================
--- s-elaall.ads (revision 0)
+++ s-elaall.ads (revision 0)
@@ -0,0 +1,57 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . E L A B O R A T I O N _ A L L O C A T O R S --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2014, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package provides the interfaces for proper handling of restriction
+-- No_Standard_Allocators_After_Elaboration. It is used only by programs
+-- which use this restriction.
+
+package System.Elaboration_Allocators is
+ pragma Preelaborate;
+
+ procedure Mark_Start_Of_Elaboration;
+ -- Called right at the start of main elaboration if the program activates
+ -- restriction No_Standard_Allocators_After_Elaboration. We don't want to
+ -- rely on the normal elaboration mechanism for marking this event, since
+ -- that would require us to be sure to elaborate this first, which would
+ -- be awkward, and it is convenient to have this package be Preelaborate.
+
+ procedure Mark_End_Of_Elaboration;
+ -- Called when main elaboration is complete if the program has activated
+ -- restriction No_Standard_Allocators_After_Elaboration. This is the point
+ -- beyond which any standard allocator use will violate the restriction.
+
+ 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
+ -- after the call to Mark_End_Of_Elaboration.
+
+end System.Elaboration_Allocators;
Index: Makefile.rtl
===================================================================
--- Makefile.rtl (revision 212660)
+++ Makefile.rtl (working copy)
@@ -518,6 +518,7 @@
s-direio$(objext) \
s-dmotpr$(objext) \
s-dsaser$(objext) \
+ s-elaall$(objext) \
s-excdeb$(objext) \
s-except$(objext) \
s-exctab$(objext) \
Index: bcheck.adb
===================================================================
--- bcheck.adb (revision 212640)
+++ bcheck.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -923,22 +923,19 @@
-- Start of processing for Check_Consistent_Restrictions
begin
- -- A special test, if we have a main program, then if it has an
- -- allocator in the body, this is considered to be a violation of
- -- the restriction No_Allocators_After_Elaboration. We just mark
- -- this restriction and then the normal circuit will flag it.
+ -- We used to have a special test here:
- if Bind_Main_Program
- and then ALIs.Table (ALIs.First).Main_Program /= None
- and then not No_Main_Subprogram
- and then ALIs.Table (ALIs.First).Allocator_In_Body
- then
- Cumulative_Restrictions.Violated
- (No_Standard_Allocators_After_Elaboration) := True;
- ALIs.Table (ALIs.First).Restrictions.Violated
- (No_Standard_Allocators_After_Elaboration) := True;
- end if;
+ -- A special test, if we have a main program, then if it has an
+ -- allocator in the body, this is considered to be a violation of
+ -- the restriction No_Allocators_After_Elaboration. We just mark
+ -- this restriction and then the normal circuit will flag it.
+ -- But we don't do that any more, because in the final version of Ada
+ -- 2012, it is statically illegal to have an allocator in a library-
+ -- level subprogram, so we don't need this bind time test any more.
+ -- If we have a main program with parameters (which GNAT allows), then
+ -- allocators in that will be caught by the run-time check.
+
-- Loop through all restriction violations
for R in All_Restrictions loop
