+2018-04-04 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Install the elaboration
+ model of the compilation unit spec, if any.
+ * sem_ch7.adb (Analyze_Package_Body_Helper): Install the elaboration
+ model of the compilation unit spec, if any.
+ * sem_ch10.adb (Analyze_Subunit): Install the elaboration model of the
+ parent compilation unit spec, if any.
+ * sem_elab.adb (Check_Elaboration_Scenarios): Restore the elaboration
+ model of the main unit.
+ (Is_Same_Unit): The routine now uses Unit_Entity.
+ (Is_Subunit): Removed.
+ (Normalize_Unit): Removed.
+ (Unit_Entity): New routine.
+ * sem_prag.adb (Analyze_Pragma): Reimplement the handling of pragma
+ Elaboration_Checks. The analysis now ensures that the pragma appears at
+ the configuration level, and on the initial declaration of a unit.
+ Other placements are either flagged as illegal, or ignored.
+ (Check_Duplicate_Elaboration_Checks_Pragma): New routine.
+ (Ignore_Elaboration_Checks_Pragma): New routine.
+ * sem_util.adb (Install_Elaboration_Model): New routine.
+ * sem_util.ads (Install_Elaboration_Model): New routine.
+ * doc/gnat_rm/implementation_defined_pragmas.rst: Update the
+ documentation of pragma Elaboration_Checks.
+ * gnat_rm.texi: Regenerate.
+
2018-04-04 Olivier Hainque <hainque@adacore.com>
* libgnat/s-trasym__dwarf.adb (Executable_Name): Return argv[0] instead
pragma Elaboration_Checks (Dynamic | Static);
-This is a configuration pragma that provides control over the
-elaboration model used by the compilation affected by the
-pragma. If the parameter is ``Dynamic``,
-then the dynamic elaboration
-model described in the Ada Reference Manual is used, as though
-the *-gnatE* switch had been specified on the command
-line. If the parameter is ``Static``, then the default GNAT static
-model is used. This configuration pragma overrides the setting
-of the command line. For full details on the elaboration models
-used by the GNAT compiler, see the chapter on elaboration order handling
-in the *GNAT User's Guide*.
+This is a configuration pragma which specifies the elaboration model to be
+used during compilation. For more information on the elaboration models of
+GNAT, consult the chapter on elaboration order handling in the *GNAT User's
+Guide*.
+The pragma may appear in the following contexts:
+
+* Configuration pragmas file
+
+* Prior to the context clauses of a compilation unit's initial declaration
+
+Any other placement of the pragma will result in a warning and the effects of
+the offending pragma will be ignored.
+
+If the pragma argument is ``Dynamic``, then the dynamic elaboration model is in
+effect. If the pragma argument is ``Static``, then the static elaboration model
+is in effect.
Pragma Eliminate
================
@copying
@quotation
-GNAT Reference Manual , Jan 10, 2018
+GNAT Reference Manual , Apr 20, 2018
AdaCore
pragma Elaboration_Checks (Dynamic | Static);
@end example
-This is a configuration pragma that provides control over the
-elaboration model used by the compilation affected by the
-pragma. If the parameter is @code{Dynamic},
-then the dynamic elaboration
-model described in the Ada Reference Manual is used, as though
-the @emph{-gnatE} switch had been specified on the command
-line. If the parameter is @code{Static}, then the default GNAT static
-model is used. This configuration pragma overrides the setting
-of the command line. For full details on the elaboration models
-used by the GNAT compiler, see the chapter on elaboration order handling
-in the @emph{GNAT User's Guide}.
+This is a configuration pragma which specifies the elaboration model to be
+used during compilation. For more information on the elaboration models of
+GNAT, consult the chapter on elaboration order handling in the @emph{GNAT User's
+Guide}.
+
+The pragma may appear in the following contexts:
+
+
+@itemize *
+
+@item
+Configuration pragmas file
+
+@item
+Prior to the context clauses of a compilation unit's initial declaration
+@end itemize
+
+Any other placement of the pragma will result in a warning and the effects of
+the offending pragma will be ignored.
+
+If the pragma argument is @code{Dynamic}, then the dynamic elaboration model is in
+effect. If the pragma argument is @code{Static}, then the static elaboration model
+is in effect.
@node Pragma Eliminate,Pragma Enable_Atomic_Synchronization,Pragma Elaboration_Checks,Implementation Defined Pragmas
@anchor{gnat_rm/implementation_defined_pragmas pragma-eliminate}@anchor{5b}
Install_SPARK_Mode (Saved_SM, Saved_SMP);
+ -- If the subunit is part of a compilation unit which is subject to
+ -- pragma Elaboration_Checks, set the model specified by the pragma
+ -- because it applies to all parts of the unit.
+
+ Install_Elaboration_Model (Par_Unit);
+
Analyze (Proper_Body (Unit (N)));
Remove_Context (N);
Mark_And_Set_Ghost_Body (N, Spec_Id);
+ -- If the body completes the initial declaration of a compilation
+ -- unit which is subject to pragma Elaboration_Checks, set the
+ -- model specified by the pragma because it applies to all parts
+ -- of the unit.
+
+ Install_Elaboration_Model (Spec_Id);
+
Set_Is_Compilation_Unit (Body_Id, Is_Compilation_Unit (Spec_Id));
Set_Is_Child_Unit (Body_Id, Is_Child_Unit (Spec_Id));
Mark_And_Set_Ghost_Body (N, Spec_Id);
+ -- If the body completes a compilation unit which is subject
+ -- to pragma Elaboration_Checks, set the model specified by
+ -- the pragma because it applies to all parts of the unit.
+
+ Install_Elaboration_Model (Spec_Id);
+
else
Spec_Id := Find_Corresponding_Spec (N);
Mark_And_Set_Ghost_Body (N, Spec_Id);
+ -- If the body completes a compilation unit which is subject
+ -- to pragma Elaboration_Checks, set the model specified by
+ -- the pragma because it applies to all parts of the unit.
+
+ Install_Elaboration_Model (Spec_Id);
+
-- In GNATprove mode, if the body has no previous spec, create
-- one so that the inlining machinery can operate properly.
-- Transfer aspects, if any, to the new spec, so that they
-- and expansion are properly marked as Ghost.
Mark_And_Set_Ghost_Body (N, Spec_Id);
+
+ -- If the body completes the initial declaration of a compilation
+ -- unit which is subject to pragma Elaboration_Checks, set the
+ -- model specified by the pragma because it applies to all parts
+ -- of the unit.
+
+ Install_Elaboration_Model (Spec_Id);
end if;
end if;
Mark_And_Set_Ghost_Body (N, Spec_Id);
+ -- If the body completes the initial declaration of a compilation unit
+ -- which is subject to pragma Elaboration_Checks, set the model of the
+ -- pragma because it applies to all parts of the unit.
+
+ Install_Elaboration_Model (Spec_Id);
+
Set_Is_Compilation_Unit (Body_Id, Is_Compilation_Unit (Spec_Id));
Style.Check_Identifier (Body_Id, Spec_Id);
-- suitable elaboration scenarios and process them. State is the current
-- state of the Processing phase.
+ function Unit_Entity (Unit_Id : Entity_Id) return Entity_Id;
+ pragma Inline (Unit_Entity);
+ -- Return the entity of the initial declaration for unit Unit_Id
+
procedure Update_Elaboration_Scenario (New_N : Node_Id; Old_N : Node_Id);
pragma Inline (Update_Elaboration_Scenario);
-- Update all relevant internal data structures when scenario Old_N is
return;
end if;
+ -- Restore the original elaboration model which was in effect when the
+ -- scenarios were first recorded. The model may be specified by pragma
+ -- Elaboration_Checks which appears on the initial declaration of the
+ -- main unit.
+
+ Install_Elaboration_Model (Unit_Entity (Cunit_Entity (Main_Unit)));
+
-- Examine the context of the main unit and record all units with prior
-- elaboration with respect to it.
(Unit_1 : Entity_Id;
Unit_2 : Entity_Id) return Boolean
is
- function Is_Subunit (Unit_Id : Entity_Id) return Boolean;
- pragma Inline (Is_Subunit);
- -- Determine whether unit Unit_Id is a subunit
-
- function Normalize_Unit (Unit_Id : Entity_Id) return Entity_Id;
- -- Strip a potential subunit chain ending with unit Unit_Id and return
- -- the corresponding spec.
-
- ----------------
- -- Is_Subunit --
- ----------------
-
- function Is_Subunit (Unit_Id : Entity_Id) return Boolean is
- begin
- return Nkind (Parent (Unit_Declaration_Node (Unit_Id))) = N_Subunit;
- end Is_Subunit;
-
- --------------------
- -- Normalize_Unit --
- --------------------
-
- function Normalize_Unit (Unit_Id : Entity_Id) return Entity_Id is
- Result : Entity_Id;
-
- begin
- -- Eliminate a potential chain of subunits to reach to proper body
-
- Result := Unit_Id;
- while Present (Result)
- and then Result /= Standard_Standard
- and then Is_Subunit (Result)
- loop
- Result := Scope (Result);
- end loop;
-
- -- Obtain the entity of the corresponding spec (if any)
-
- return Unique_Entity (Result);
- end Normalize_Unit;
-
- -- Start of processing for Is_Same_Unit
-
begin
- return Normalize_Unit (Unit_1) = Normalize_Unit (Unit_2);
+ return Unit_Entity (Unit_1) = Unit_Entity (Unit_2);
end Is_Same_Unit;
-----------------
end if;
end Traverse_Body;
+ -----------------
+ -- Unit_Entity --
+ -----------------
+
+ function Unit_Entity (Unit_Id : Entity_Id) return Entity_Id is
+ function Is_Subunit (Id : Entity_Id) return Boolean;
+ pragma Inline (Is_Subunit);
+ -- Determine whether the entity of an initial declaration denotes a
+ -- subunit.
+
+ ----------------
+ -- Is_Subunit --
+ ----------------
+
+ function Is_Subunit (Id : Entity_Id) return Boolean is
+ Decl : constant Node_Id := Unit_Declaration_Node (Id);
+
+ begin
+ return
+ Nkind_In (Decl, N_Generic_Package_Declaration,
+ N_Generic_Subprogram_Declaration,
+ N_Package_Declaration,
+ N_Protected_Type_Declaration,
+ N_Subprogram_Declaration,
+ N_Task_Type_Declaration)
+ and then Present (Corresponding_Body (Decl))
+ and then Nkind (Parent (Unit_Declaration_Node
+ (Corresponding_Body (Decl)))) = N_Subunit;
+ end Is_Subunit;
+
+ -- Local variables
+
+ Id : Entity_Id;
+
+ -- Start of processing for Unit_Entity
+
+ begin
+ Id := Unique_Entity (Unit_Id);
+
+ -- Skip all subunits found in the scope chain which ends at the input
+ -- unit.
+
+ while Is_Subunit (Id) loop
+ Id := Scope (Id);
+ end loop;
+
+ return Id;
+ end Unit_Entity;
+
---------------------------------
-- Update_Elaboration_Scenario --
---------------------------------
-- pragma Elaboration_Checks (Static | Dynamic);
- when Pragma_Elaboration_Checks =>
+ when Pragma_Elaboration_Checks => Elaboration_Checks : declare
+ procedure Check_Duplicate_Elaboration_Checks_Pragma;
+ -- Emit an error if the current context list already contains
+ -- a previous Elaboration_Checks pragma. This routine raises
+ -- Pragma_Exit if a duplicate is found.
+
+ procedure Ignore_Elaboration_Checks_Pragma;
+ -- Warn that the effects of the pragma are ignored. This routine
+ -- raises Pragma_Exit.
+
+ -----------------------------------------------
+ -- Check_Duplicate_Elaboration_Checks_Pragma --
+ -----------------------------------------------
+
+ procedure Check_Duplicate_Elaboration_Checks_Pragma is
+ Item : Node_Id;
+
+ begin
+ Item := Prev (N);
+ while Present (Item) loop
+ if Nkind (Item) = N_Pragma
+ and then Pragma_Name (Item) = Name_Elaboration_Checks
+ then
+ Duplication_Error
+ (Prag => N,
+ Prev => Item);
+ raise Pragma_Exit;
+ end if;
+
+ Prev (Item);
+ end loop;
+ end Check_Duplicate_Elaboration_Checks_Pragma;
+
+ --------------------------------------
+ -- Ignore_Elaboration_Checks_Pragma --
+ --------------------------------------
+
+ procedure Ignore_Elaboration_Checks_Pragma is
+ begin
+ Error_Msg_Name_1 := Pname;
+ Error_Msg_N ("??effects of pragma % are ignored", N);
+ Error_Msg_N
+ ("\place pragma on initial declaration of library unit", N);
+
+ raise Pragma_Exit;
+ end Ignore_Elaboration_Checks_Pragma;
+
+ -- Local variables
+
+ Context : constant Node_Id := Parent (N);
+ Unt : Node_Id;
+
+ -- Start of processing for Elaboration_Checks
+
+ begin
GNAT_Pragma;
Check_Arg_Count (1);
Check_Arg_Is_One_Of (Arg1, Name_Static, Name_Dynamic);
- -- Set flag accordingly (ignore attempt at dynamic elaboration
- -- checks in SPARK mode).
+ -- The pragma appears in a configuration file
+
+ if No (Context) then
+ Check_Valid_Configuration_Pragma;
+ Check_Duplicate_Elaboration_Checks_Pragma;
+
+ -- The pragma acts as a configuration pragma in a compilation unit
+
+ -- pragma Elaboration_Checks (...);
+ -- package Pack is ...;
+
+ elsif Nkind (Context) = N_Compilation_Unit
+ and then List_Containing (N) = Context_Items (Context)
+ then
+ Check_Valid_Configuration_Pragma;
+ Check_Duplicate_Elaboration_Checks_Pragma;
+
+ Unt := Unit (Context);
+
+ -- The pragma must appear on the initial declaration of a unit.
+ -- If this is not the case, warn that the effects of the pragma
+ -- are ignored.
+
+ if Nkind (Unt) = N_Package_Body then
+ Ignore_Elaboration_Checks_Pragma;
+
+ -- Check the Acts_As_Spec flag of the compilation units itself
+ -- to determine whether the subprogram body completes since it
+ -- has not been analyzed yet. This is safe because compilation
+ -- units are not overloadable.
+
+ elsif Nkind (Unt) = N_Subprogram_Body
+ and then not Acts_As_Spec (Context)
+ then
+ Ignore_Elaboration_Checks_Pragma;
+
+ elsif Nkind (Unt) = N_Subunit then
+ Ignore_Elaboration_Checks_Pragma;
+ end if;
+
+ -- Otherwise the pragma does not appear at the configuration level
+ -- and is illegal.
+
+ else
+ Pragma_Misplaced;
+ end if;
+
+ -- At this point the pragma is not a duplicate, and appears in the
+ -- proper context. Set the elaboration model in effect.
Dynamic_Elaboration_Checks :=
Chars (Get_Pragma_Arg (Arg1)) = Name_Dynamic;
+ end Elaboration_Checks;
---------------
-- Eliminate --
end loop;
end Inspect_Deferred_Constant_Completion;
+ -------------------------------
+ -- Install_Elaboration_Model --
+ -------------------------------
+
+ procedure Install_Elaboration_Model (Unit_Id : Entity_Id) is
+ function Find_Elaboration_Checks_Pragma (L : List_Id) return Node_Id;
+ -- Try to find pragma Elaboration_Checks in arbitrary list L. Return
+ -- Empty if there is no such pragma.
+
+ ------------------------------------
+ -- Find_Elaboration_Checks_Pragma --
+ ------------------------------------
+
+ function Find_Elaboration_Checks_Pragma (L : List_Id) return Node_Id is
+ Item : Node_Id;
+
+ begin
+ Item := First (L);
+ while Present (Item) loop
+ if Nkind (Item) = N_Pragma
+ and then Pragma_Name (Item) = Name_Elaboration_Checks
+ then
+ return Item;
+ end if;
+
+ Next (Item);
+ end loop;
+
+ return Empty;
+ end Find_Elaboration_Checks_Pragma;
+
+ -- Local variables
+
+ Args : List_Id;
+ Model : Node_Id;
+ Prag : Node_Id;
+ Unit : Node_Id;
+
+ -- Start of processing for Install_Elaboration_Model
+
+ begin
+ -- Nothing to do when the unit does not exist
+
+ if No (Unit_Id) then
+ return;
+ end if;
+
+ Unit := Parent (Unit_Declaration_Node (Unit_Id));
+
+ -- Nothing to do when the unit is not a library unit
+
+ if Nkind (Unit) /= N_Compilation_Unit then
+ return;
+ end if;
+
+ Prag := Find_Elaboration_Checks_Pragma (Context_Items (Unit));
+
+ -- The compilation unit is subject to pragma Elaboration_Checks. Set the
+ -- elaboration model as specified by the pragma.
+
+ if Present (Prag) then
+ Args := Pragma_Argument_Associations (Prag);
+
+ -- Guard against an illegal pragma. The sole argument must be an
+ -- identifier which specifies either Dynamic or Static model.
+
+ if Present (Args) then
+ Model := Get_Pragma_Arg (First (Args));
+
+ if Nkind (Model) = N_Identifier then
+ Dynamic_Elaboration_Checks := Chars (Model) = Name_Dynamic;
+ end if;
+ end if;
+ end if;
+ end Install_Elaboration_Model;
+
-----------------------------
-- Install_Generic_Formals --
-----------------------------
-- whether they have been completed by a full constant declaration or an
-- Import pragma. Emit the error message if that is not the case.
+ procedure Install_Elaboration_Model (Unit_Id : Entity_Id);
+ -- Install the elaboration model specified by pragma Elaboration_Checks
+ -- associated with compilation unit Unit_Id. No action is taken when the
+ -- unit lacks such pragma.
+
procedure Install_Generic_Formals (Subp_Id : Entity_Id);
-- Install both the generic formal parameters and the formal parameters of
-- generic subprogram Subp_Id into visibility.
projects / gcc.git / commitdiff