Commit c31b57af by Eric Botcazou Committed by Arnaud Charlet

einfo.ads (Overlays_Constant): Document usage for E_Constant.

2015-11-12  Eric Botcazou  <ebotcazou@adacore.com>

	* einfo.ads (Overlays_Constant): Document usage for E_Constant.
	* freeze.adb (Warn_Overlay): Small reformatting.
	(Check_Address_Clause): Deal specifically with deferred
	constants.  For a variable or a non-imported constant
	overlaying a constant object and with initialization value,
	either remove the initialization or issue a warning.  Fix a
	couple of typos.
	* sem_util.adb (Note_Possible_Modification): Overhaul the condition for
	the warning on modified constants and use Find_Overlaid_Entity instead
	of doing it manually.
	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Compute and
	set Overlays_Constant once on entry.  Do not treat the overlaid
	entity as volatile.  Do not issue the warning on modified
	constants here.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Constant>: Remove
	over-restrictive condition for the special treatment of deferred
	constants.
	<E_Variable>: Remove obsolete associated code.

From-SVN: r230229
parent 16f19962
2015-11-12 Eric Botcazou <ebotcazou@adacore.com>
* einfo.ads (Overlays_Constant): Document usage for E_Constant.
* freeze.adb (Warn_Overlay): Small reformatting.
(Check_Address_Clause): Deal specifically with deferred
constants. For a variable or a non-imported constant
overlaying a constant object and with initialization value,
either remove the initialization or issue a warning. Fix a
couple of typos.
* sem_util.adb (Note_Possible_Modification): Overhaul the condition for
the warning on modified constants and use Find_Overlaid_Entity instead
of doing it manually.
* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Compute and
set Overlays_Constant once on entry. Do not treat the overlaid
entity as volatile. Do not issue the warning on modified
constants here.
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Constant>: Remove
over-restrictive condition for the special treatment of deferred
constants.
<E_Variable>: Remove obsolete associated code.
2015-11-12 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (gnat_to_gnu) <N_Subprogram_Renaming_Decl>: Do
not materialize renamed subprograms if only annotating types.
......
......@@ -3638,8 +3638,9 @@ package Einfo is
-- Points to the component in the base type.
-- Overlays_Constant (Flag243)
-- Defined in all entities. Set only for a variable for which there is
-- an address clause which causes the variable to overlay a constant.
-- Defined in all entities. Set only for E_Constant or E_Variable for
-- which there is an address clause which causes the entity to overlay
-- a constant object.
-- Overridden_Operation (Node26)
-- Defined in subprograms. For overriding operations, points to the
......
......@@ -207,10 +207,7 @@ package body Freeze is
-- this to have a Freeze_Node, so ensure it doesn't. Do the same for any
-- Full_View or Corresponding_Record_Type.
procedure Warn_Overlay
(Expr : Node_Id;
Typ : Entity_Id;
Nam : Node_Id);
procedure Warn_Overlay (Expr : Node_Id; Typ : Entity_Id; Nam : Node_Id);
-- Expr is the expression for an address clause for entity Nam whose type
-- is Typ. If Typ has a default initialization, and there is no explicit
-- initialization in the source declaration, check whether the address
......@@ -598,16 +595,25 @@ package body Freeze is
--------------------------
procedure Check_Address_Clause (E : Entity_Id) is
Addr : constant Node_Id := Address_Clause (E);
Addr : constant Node_Id := Address_Clause (E);
Typ : constant Entity_Id := Etype (E);
Decl : Node_Id;
Expr : Node_Id;
Decl : constant Node_Id := Declaration_Node (E);
Loc : constant Source_Ptr := Sloc (Decl);
Typ : constant Entity_Id := Etype (E);
Init : Node_Id;
Lhs : Node_Id;
Tag_Assign : Node_Id;
begin
if Present (Addr) then
-- For a deferred constant, the initialization value is on full view
if Ekind (E) = E_Constant and then Present (Full_View (E)) then
Decl := Declaration_Node (Full_View (E));
else
Decl := Declaration_Node (E);
end if;
Expr := Expression (Addr);
if Needs_Constant_Address (Decl, Typ) then
......@@ -656,29 +662,72 @@ package body Freeze is
Warn_Overlay (Expr, Typ, Name (Addr));
end if;
if Present (Expression (Decl)) then
Init := Expression (Decl);
-- If a variable, or a non-imported constant, overlays a constant
-- object and has an initialization value, then the initialization
-- may end up writing into read-only memory. Detect the cases of
-- statically identical values and remove the initialization. In
-- the other cases, give a warning. We will give other warnings
-- later for the variable if it is assigned.
if (Ekind (E) = E_Variable
or else (Ekind (E) = E_Constant
and then not Is_Imported (E)))
and then Overlays_Constant (E)
and then Present (Init)
then
declare
O_Ent : Entity_Id;
Off : Boolean;
begin
Find_Overlaid_Entity (Addr, O_Ent, Off);
if Ekind (O_Ent) = E_Constant
and then Etype (O_Ent) = Typ
and then Present (Constant_Value (O_Ent))
and then Compile_Time_Compare (
Init,
Constant_Value (O_Ent),
Assume_Valid => True) = EQ
then
Set_No_Initialization (Decl);
return;
elsif Comes_From_Source (Init)
and then Address_Clause_Overlay_Warnings
then
Error_Msg_Sloc := Sloc (Addr);
Error_Msg_NE
("??constant& may be modified via address clause#",
Decl, O_Ent);
end if;
end;
end if;
if Present (Init) then
-- Capture initialization value at point of declaration,
-- and make explicit assignment legal, because object may
-- be a constant.
Remove_Side_Effects (Expression (Decl));
Lhs := New_Occurrence_Of (E, Loc);
Remove_Side_Effects (Init);
Lhs := New_Occurrence_Of (E, Sloc (Decl));
Set_Assignment_OK (Lhs);
-- Move initialization to freeze actions (once the object has
-- been frozen, and the address clause alignment check has been
-- Move initialization to freeze actions, once the object has
-- been frozen and the address clause alignment check has been
-- performed.
Append_Freeze_Action (E,
Make_Assignment_Statement (Loc,
Make_Assignment_Statement (Sloc (Decl),
Name => Lhs,
Expression => Expression (Decl)));
Set_No_Initialization (Decl);
-- If the objet is tagged, check whether the tag must be
-- reassigned expliitly.
-- reassigned explicitly.
Tag_Assign := Make_Tag_Assignment (Decl);
if Present (Tag_Assign) then
......@@ -8128,11 +8177,7 @@ package body Freeze is
-- Warn_Overlay --
------------------
procedure Warn_Overlay
(Expr : Node_Id;
Typ : Entity_Id;
Nam : Entity_Id)
is
procedure Warn_Overlay (Expr : Node_Id; Typ : Entity_Id; Nam : Entity_Id) is
Ent : constant Entity_Id := Entity (Nam);
-- The object to which the address clause applies
......
......@@ -506,7 +506,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* Ignore constant definitions already marked with the error node. See
the N_Object_Declaration case of gnat_to_gnu for the rationale. */
if (definition
&& gnu_expr
&& present_gnu_tree (gnat_entity)
&& get_gnu_tree (gnat_entity) == error_mark_node)
{
......@@ -1186,13 +1185,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
}
}
/* If this is a deferred constant, the initializer is attached to
the full view. */
if (kind == E_Constant && Present (Full_View (gnat_entity)))
gnu_expr
= gnat_to_gnu
(Expression (Declaration_Node (Full_View (gnat_entity))));
/* If we don't have an initializing expression for the underlying
variable, the initializing expression for the pointer is the
specified address. Otherwise, we have to make a COMPOUND_EXPR
......
......@@ -4724,6 +4724,12 @@ package body Sem_Ch13 is
Find_Overlaid_Entity (N, O_Ent, Off);
-- If the object overlays a constant view, mark it so
if Present (O_Ent) and then Is_Constant_Object (O_Ent) then
Set_Overlays_Constant (U_Ent);
end if;
-- Overlaying controlled objects is erroneous.
-- Emit warning but continue analysis because program is
-- itself legal, and back-end must see address clause.
......@@ -4743,12 +4749,12 @@ package body Sem_Ch13 is
-- Issue an unconditional warning for a constant overlaying
-- a variable. For the reverse case, we will issue it only
-- if the variable is modified, see below.
-- if the variable is modified.
elsif Address_Clause_Overlay_Warnings
elsif Ekind (U_Ent) = E_Constant
and then Present (O_Ent)
and then Ekind (U_Ent) = E_Constant
and then not Is_Constant_Object (O_Ent)
and then not Overlays_Constant (U_Ent)
and then Address_Clause_Overlay_Warnings
then
Error_Msg_N ("??constant overlays a variable", Expr);
......@@ -4767,34 +4773,6 @@ package body Sem_Ch13 is
Note_Possible_Modification (Nam, Sure => False);
-- Here we are checking for explicit overlap of one variable
-- by another, and if we find this then mark the overlapped
-- variable as also being volatile to prevent unwanted
-- optimizations. This is a significant pessimization so
-- avoid it when there is an offset, i.e. when the object
-- is composite; they cannot be optimized easily anyway.
if Present (O_Ent)
and then Is_Object (O_Ent)
and then not Off
-- The following test is an expedient solution to what
-- is really a problem in CodePeer. Suppressing the
-- Set_Treat_As_Volatile call here prevents later
-- generation (in some cases) of trees that CodePeer
-- should, but currently does not, handle correctly.
-- This test should probably be removed when CodePeer
-- is improved, just because we want the tree CodePeer
-- analyzes to match the tree for which we generate code
-- as closely as is practical. ???
and then not CodePeer_Mode
then
-- ??? O_Ent might not be in current unit
Set_Treat_As_Volatile (O_Ent);
end if;
-- Legality checks on the address clause for initialized
-- objects is deferred until the freeze point, because
-- a subsequent pragma might indicate that the object
......@@ -4867,39 +4845,12 @@ package body Sem_Ch13 is
-- Furthermore, by removing the test, we handle the
-- aspect case properly.
if Address_Clause_Overlay_Warnings
and then Present (O_Ent)
if Present (O_Ent)
and then Is_Object (O_Ent)
and then not Is_Generic_Type (Etype (U_Ent))
and then Address_Clause_Overlay_Warnings
then
if not Is_Generic_Type (Etype (U_Ent)) then
Address_Clause_Checks.Append ((N, U_Ent, O_Ent, Off));
end if;
-- If variable overlays a constant view, and we are
-- warning on overlays, then mark the variable as
-- overlaying a constant and warn immediately if it
-- is initialized. We will give other warnings later
-- if the variable is assigned.
if Is_Constant_Object (O_Ent)
and then Ekind (U_Ent) = E_Variable
then
declare
Init : constant Node_Id :=
Expression (Declaration_Node (U_Ent));
begin
Set_Overlays_Constant (U_Ent);
if Present (Init)
and then Comes_From_Source (Init)
then
Error_Msg_Sloc := Sloc (N);
Error_Msg_NE
("??constant& may be modified via address "
& "clause#", Declaration_Node (U_Ent), O_Ent);
end if;
end;
end if;
Address_Clause_Checks.Append ((N, U_Ent, O_Ent, Off));
end if;
end;
......
......@@ -16258,27 +16258,22 @@ package body Sem_Util is
-- If we are sure this is a modification from source, and we know
-- this modifies a constant, then give an appropriate warning.
if Overlays_Constant (Ent)
and then (Modification_Comes_From_Source and Sure)
if Sure
and then Modification_Comes_From_Source
and then Overlays_Constant (Ent)
and then Address_Clause_Overlay_Warnings
then
declare
A : constant Node_Id := Address_Clause (Ent);
Addr : constant Node_Id := Address_Clause (Ent);
O_Ent : Entity_Id;
Off : Boolean;
begin
if Present (A) then
declare
Exp : constant Node_Id := Expression (A);
begin
if Nkind (Exp) = N_Attribute_Reference
and then Attribute_Name (Exp) = Name_Address
and then Is_Entity_Name (Prefix (Exp))
then
Error_Msg_Sloc := Sloc (A);
Error_Msg_NE
("constant& may be modified via address "
& "clause#??", N, Entity (Prefix (Exp)));
end if;
end;
end if;
Find_Overlaid_Entity (Addr, O_Ent, Off);
Error_Msg_Sloc := Sloc (Addr);
Error_Msg_NE
("??constant& may be modified via address clause#",
N, O_Ent);
end;
end if;
......
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