Commit de4899bb by Arnaud Charlet

[multiple changes]

2014-11-20  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch3.adb (Expand_N_Object_Declaration): Handle properly
	a type invariant check on an object with default initialization
	and an address clause.

2014-11-20  Robert Dewar  <dewar@adacore.com>

	* sem_elab.adb (Check_A_Call): Handle variable ref case in
	SPARK (Check_Elab_Call): ditto (Find_Elab_Reference): ditto
	(Get_Referenced_Ent): ditto.
	* sem_elab.ads: Comment fixes to account for the fact that we
	now deal with variable references in SPARK mode.
	* sem_res.adb (Resolve_Entity_Name): In SPARK_Mode Call
	Check_Elab_Call for variable.

2014-11-20  Yannick Moy  <moy@adacore.com>

	* a-cofove.ads (Copy): Fix precondition, which should allow
	Capacity = 0.
	(First_To_Previous, Current_To_Last): Add necessary preconditions.

From-SVN: r217878
parent 8c691dc6
2014-11-20 Ed Schonberg <schonberg@adacore.com>
* exp_ch3.adb (Expand_N_Object_Declaration): Handle properly
a type invariant check on an object with default initialization
and an address clause.
2014-11-20 Robert Dewar <dewar@adacore.com>
* sem_elab.adb (Check_A_Call): Handle variable ref case in
SPARK (Check_Elab_Call): ditto (Find_Elab_Reference): ditto
(Get_Referenced_Ent): ditto.
* sem_elab.ads: Comment fixes to account for the fact that we
now deal with variable references in SPARK mode.
* sem_res.adb (Resolve_Entity_Name): In SPARK_Mode Call
Check_Elab_Call for variable.
2014-11-20 Yannick Moy <moy@adacore.com>
* a-cofove.ads (Copy): Fix precondition, which should allow
Capacity = 0.
(First_To_Previous, Current_To_Last): Add necessary preconditions.
2014-11-20 Hristian Kirtchev <kirtchev@adacore.com> 2014-11-20 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch3.adb (Build_Initialization_Call): Reimplement the * exp_ch3.adb (Build_Initialization_Call): Reimplement the
......
...@@ -114,7 +114,7 @@ is ...@@ -114,7 +114,7 @@ is
Capacity : Capacity_Range := 0) return Vector Capacity : Capacity_Range := 0) return Vector
with with
Global => null, Global => null,
Pre => (if Bounded then Length (Source) <= Capacity); Pre => (if Bounded then (Capacity = 0 or Length (Source) <= Capacity));
function Element function Element
(Container : Vector; (Container : Vector;
...@@ -195,7 +195,9 @@ is ...@@ -195,7 +195,9 @@ is
Global => null; Global => null;
function Has_Element function Has_Element
(Container : Vector; Position : Extended_Index) return Boolean with (Container : Vector;
Position : Extended_Index) return Boolean
with
Global => null; Global => null;
generic generic
...@@ -212,17 +214,19 @@ is ...@@ -212,17 +214,19 @@ is
function First_To_Previous function First_To_Previous
(Container : Vector; (Container : Vector;
Current : Index_Type) return Vector Current : Index_Type) return Vector
with with
Ghost, Ghost,
Global => null; Global => null,
Pre => Current in First_Index (Container) .. Last_Index (Container);
function Current_To_Last function Current_To_Last
(Container : Vector; (Container : Vector;
Current : Index_Type) return Vector Current : Index_Type) return Vector
with with
Ghost, Ghost,
Global => null; Global => null,
Pre => Current in First_Index (Container) .. Last_Index (Container);
-- First_To_Previous returns a container containing all elements preceding -- First_To_Previous returns a container containing all elements preceding
-- Current (excluded) in Container. Current_To_Last returns a container -- Current (excluded) in Container. Current_To_Last returns a container
-- containing all elements following Current (included) in Container. -- containing all elements following Current (included) in Container.
......
...@@ -23,6 +23,7 @@ ...@@ -23,6 +23,7 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Aspects; use Aspects;
with Atree; use Atree; with Atree; use Atree;
with Checks; use Checks; with Checks; use Checks;
with Einfo; use Einfo; with Einfo; use Einfo;
...@@ -5462,8 +5463,23 @@ package body Exp_Ch3 is ...@@ -5462,8 +5463,23 @@ package body Exp_Ch3 is
and then not Has_Init_Expression (N) and then not Has_Init_Expression (N)
and then not No_Initialization (N) and then not No_Initialization (N)
then then
Insert_After (N, -- If entity has an address clause or aspect, make invariant
Make_Invariant_Call (New_Occurrence_Of (Def_Id, Loc))); -- call into a freeze action for the explicit freeze node for
-- object. Otherwise insert invariant check after declaration.
if Present (Following_Address_Clause (N))
or else Has_Aspect (Def_Id, Aspect_Address)
then
Ensure_Freeze_Node (Def_Id);
Set_Has_Delayed_Freeze (Def_Id);
Set_Is_Frozen (Def_Id, False);
Append_Freeze_Action (Def_Id,
Make_Invariant_Call (New_Occurrence_Of (Def_Id, Loc)));
else
Insert_After (N,
Make_Invariant_Call (New_Occurrence_Of (Def_Id, Loc)));
end if;
end if; end if;
Default_Initialize_Object (Init_After); Default_Initialize_Object (Init_After);
......
...@@ -35,41 +35,48 @@ package Sem_Elab is ...@@ -35,41 +35,48 @@ package Sem_Elab is
-- Description of Approach -- -- Description of Approach --
----------------------------- -----------------------------
-- Every non-static call that is encountered by Sem_Res results in -- Every non-static call that is encountered by Sem_Res results in a call
-- a call to Check_Elab_Call, with N being the call node, and Outer -- to Check_Elab_Call, with N being the call node, and Outer set to its
-- set to its default value of True. -- default value of True. In addition X'Access is treated like a call
-- for the access-to-procedure case, and in SPARK mode only we also
-- The goal of Check_Elab_Call is to determine whether or not the -- check variable references.
-- call in question can generate an access before elaboration
-- error (raising Program_Error) either by directly calling a -- The goal of Check_Elab_Call is to determine whether or not the reference
-- subprogram whose body has not yet been elaborated, or indirectly, -- in question can generate an access before elaboration error (raising
-- by calling a subprogram whose body has been elaborated, but which -- Program_Error) either by directly calling a subprogram whose body
-- contains a call to such a subprogram. -- has not yet been elaborated, or indirectly, by calling a subprogram
-- whose body has been elaborated, but which contains a call to such a
-- The only calls that we need to look at at the outer level are -- subprogram.
-- calls that occur in elaboration code. There are two cases. The
-- call can be at the outer level of elaboration code, or it can -- In addition, in SPARK mode, we are checking for a variable reference in
-- another package, which requires an explicit Elaborate_All pragma.
-- The only references that we need to look at at the outer level are
-- references that occur in elaboration code. There are two cases. The
-- reference can be at the outer level of elaboration code, or it can
-- be within another unit, e.g. the elaboration code of a subprogram. -- be within another unit, e.g. the elaboration code of a subprogram.
-- In the case of an elaboration call at the outer level, we must -- In the case of an elaboration call at the outer level, we must trace
-- trace all calls to outer level routines either within the current -- all calls to outer level routines either within the current unit or to
-- unit or to other units that are with'ed. For calls within the -- other units that are with'ed. For calls within the current unit, we can
-- current unit, we can determine if the body has been elaborated -- determine if the body has been elaborated or not, and if it has not,
-- or not, and if it has not, then a warning is generated. -- then a warning is generated.
-- Note that there are two subcases. If the original call directly -- Note that there are two subcases. If the original call directly calls a
-- calls a subprogram whose body has not been elaborated, then we -- subprogram whose body has not been elaborated, then we know that an ABE
-- know that an ABE will take place, and we replace the call by -- will take place, and we replace the call by a raise of Program_Error.
-- a raise of Program_Error. If the call is indirect, then we don't -- If the call is indirect, then we don't know that the PE will be raised,
-- know that the PE will be raised, since the call might be guarded -- since the call might be guarded by a conditional. In this case we set
-- by a conditional. In this case we set Do_Elab_Check on the call -- Do_Elab_Check on the call so that a dynamic check is generated, and
-- so that a dynamic check is generated, and output a warning. -- output a warning.
-- For calls to a subprogram in a with'ed unit, we require that -- For calls to a subprogram in a with'ed unit or a 'Access or variable
-- a pragma Elaborate_All or pragma Elaborate be present, or that -- refernece (SPARK mode case), we require that a pragma Elaborate_All
-- the referenced unit have a pragma Preelaborate, pragma Pure, or -- or pragma Elaborate be present, or that the referenced unit have a
-- pragma Elaborate_Body. If none of these conditions is met, then -- pragma Preelaborate, pragma Pure, or pragma Elaborate_Body. If none
-- a warning is generated that a pragma Elaborate_All may be needed. -- of these conditions is met, then a warning is generated that a pragma
-- Elaborate_All may be needed (error in the SPARK case), or an implicit
-- pragma is generated.
-- For the case of an elaboration call at some inner level, we are -- For the case of an elaboration call at some inner level, we are
-- interested in tracing only calls to subprograms at the same level, -- interested in tracing only calls to subprograms at the same level,
...@@ -86,9 +93,8 @@ package Sem_Elab is ...@@ -86,9 +93,8 @@ package Sem_Elab is
-- Elaborate on a with'ed unit guarantees that subprograms within the -- Elaborate on a with'ed unit guarantees that subprograms within the
-- unit can be called without causing an ABE. This is not in fact the -- unit can be called without causing an ABE. This is not in fact the
-- case since pragma Elaborate does not guarantee the transitive -- case since pragma Elaborate does not guarantee the transitive
-- coverage guaranteed by Elaborate_All. However, we leave this issue -- coverage guaranteed by Elaborate_All. However, we decide to trust
-- up to the binder, which has generates warnings if there are possible -- the user in this case.
-- problems in the use of pragma Elaborate.
-------------------------------------- --------------------------------------
-- Instantiation Elaboration Errors -- -- Instantiation Elaboration Errors --
...@@ -124,11 +130,21 @@ package Sem_Elab is ...@@ -124,11 +130,21 @@ package Sem_Elab is
In_Init_Proc : Boolean := False); In_Init_Proc : Boolean := False);
-- Check a call for possible elaboration problems. The node N is either an -- Check a call for possible elaboration problems. The node N is either an
-- N_Function_Call or N_Procedure_Call_Statement node or an access -- N_Function_Call or N_Procedure_Call_Statement node or an access
-- attribute reference whose prefix is a subprogram. The Outer_Scope -- attribute reference whose prefix is a subprogram.
-- argument indicates whether this is an outer level call from Sem_Res --
-- (Outer_Scope set to Empty), or an internal recursive call (Outer_Scope -- If SPARK_Mode is On, then N can also be a variablr reference, since
-- set to entity of outermost call, see body). Flag In_Init_Proc should be -- SPARK requires the use of Elaborate_All for references to variables
-- set whenever the current context is a type init proc. -- in other packages.
-- The Outer_Scope argument indicates whether this is an outer level
-- call from Sem_Res (Outer_Scope set to Empty), or an internal recursive
-- call (Outer_Scope set to entity of outermost call, see body). The flag
-- In_Init_Proc should be set whenever the current context is a type
-- init proc.
-- Note: this might better be called Check_Elab_Reference (to recognize
-- the SPARK case), but we prefer to keep the original name, since this
-- is primarily used for checking for calls that could generate an ABE).
procedure Check_Elab_Calls; procedure Check_Elab_Calls;
-- Not all the processing for Check_Elab_Call can be done at the time -- Not all the processing for Check_Elab_Call can be done at the time
......
...@@ -7172,8 +7172,8 @@ package body Sem_Res is ...@@ -7172,8 +7172,8 @@ package body Sem_Res is
if SPARK_Mode = On if SPARK_Mode = On
and then Is_Object (E) and then Is_Object (E)
and then Is_Effectively_Volatile (E) and then Is_Effectively_Volatile (E)
and then and then (Async_Writers_Enabled (E)
(Async_Writers_Enabled (E) or else Effective_Reads_Enabled (E)) or else Effective_Reads_Enabled (E))
and then Comes_From_Source (N) and then Comes_From_Source (N)
then then
-- The effectively volatile objects appears in a "non-interfering -- The effectively volatile objects appears in a "non-interfering
...@@ -7197,6 +7197,12 @@ package body Sem_Res is ...@@ -7197,6 +7197,12 @@ package body Sem_Res is
if Is_Ghost_Entity (E) and then Comes_From_Source (N) then if Is_Ghost_Entity (E) and then Comes_From_Source (N) then
Check_Ghost_Context (E, N); Check_Ghost_Context (E, N);
end if; end if;
-- In SPARK mode, need to check possible elaboration issues
if SPARK_Mode = On and then Ekind (E) = E_Variable then
Check_Elab_Call (N);
end if;
end Resolve_Entity_Name; end Resolve_Entity_Name;
------------------- -------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment