Skip to content

R
riscv-gcc-1
Commit c31b57af by Eric Botcazou Committed by Arnaud Charlet
Options

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
Showing with 116 additions and 111 deletions
gcc/ada/ChangeLog
2015-11-12 Eric Botcazou <ebotcazou@adacore.com> 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 * gcc-interface/trans.c (gnat_to_gnu) <N_Subprogram_Renaming_Decl>: Do
not materialize renamed subprograms if only annotating types. not materialize renamed subprograms if only annotating types.
......
gcc/ada/einfo.ads
...@@ -3638,8 +3638,9 @@ package Einfo is ...@@ -3638,8 +3638,9 @@ package Einfo is
-- Points to the component in the base type. -- Points to the component in the base type.
-- Overlays_Constant (Flag243) -- Overlays_Constant (Flag243)
-- Defined in all entities. Set only for a variable for which there is -- Defined in all entities. Set only for E_Constant or E_Variable for
-- an address clause which causes the variable to overlay a constant. -- which there is an address clause which causes the entity to overlay
-- a constant object.
-- Overridden_Operation (Node26) -- Overridden_Operation (Node26)
-- Defined in subprograms. For overriding operations, points to the -- Defined in subprograms. For overriding operations, points to the
......
gcc/ada/freeze.adb
...@@ -207,10 +207,7 @@ package body Freeze is ...@@ -207,10 +207,7 @@ package body Freeze is
-- this to have a Freeze_Node, so ensure it doesn't. Do the same for any -- this to have a Freeze_Node, so ensure it doesn't. Do the same for any
-- Full_View or Corresponding_Record_Type. -- Full_View or Corresponding_Record_Type.
procedure Warn_Overlay procedure Warn_Overlay (Expr : Node_Id; Typ : Entity_Id; Nam : Node_Id);
(Expr : Node_Id;
Typ : Entity_Id;
Nam : Node_Id);
-- Expr is the expression for an address clause for entity Nam whose type -- 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 -- is Typ. If Typ has a default initialization, and there is no explicit
-- initialization in the source declaration, check whether the address -- initialization in the source declaration, check whether the address
...@@ -598,16 +595,25 @@ package body Freeze is ...@@ -598,16 +595,25 @@ package body Freeze is
-------------------------- --------------------------
procedure Check_Address_Clause (E : Entity_Id) 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; Expr : Node_Id;
Decl : constant Node_Id := Declaration_Node (E); Init : Node_Id;
Loc : constant Source_Ptr := Sloc (Decl);
Typ : constant Entity_Id := Etype (E);
Lhs : Node_Id; Lhs : Node_Id;
Tag_Assign : Node_Id; Tag_Assign : Node_Id;
begin begin
if Present (Addr) then 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); Expr := Expression (Addr);
if Needs_Constant_Address (Decl, Typ) then if Needs_Constant_Address (Decl, Typ) then
...@@ -656,29 +662,72 @@ package body Freeze is ...@@ -656,29 +662,72 @@ package body Freeze is
Warn_Overlay (Expr, Typ, Name (Addr)); Warn_Overlay (Expr, Typ, Name (Addr));
end if; 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, -- Capture initialization value at point of declaration,
-- and make explicit assignment legal, because object may -- and make explicit assignment legal, because object may
-- be a constant. -- be a constant.
Remove_Side_Effects (Expression (Decl)); Remove_Side_Effects (Init);
Lhs := New_Occurrence_Of (E, Loc); Lhs := New_Occurrence_Of (E, Sloc (Decl));
Set_Assignment_OK (Lhs); Set_Assignment_OK (Lhs);
-- Move initialization to freeze actions (once the object has -- Move initialization to freeze actions, once the object has
-- been frozen, and the address clause alignment check has been -- been frozen and the address clause alignment check has been
-- performed. -- performed.
Append_Freeze_Action (E, Append_Freeze_Action (E,
Make_Assignment_Statement (Loc, Make_Assignment_Statement (Sloc (Decl),
Name => Lhs, Name => Lhs,
Expression => Expression (Decl))); Expression => Expression (Decl)));
Set_No_Initialization (Decl); Set_No_Initialization (Decl);
-- If the objet is tagged, check whether the tag must be -- If the objet is tagged, check whether the tag must be
-- reassigned expliitly. -- reassigned explicitly.
Tag_Assign := Make_Tag_Assignment (Decl); Tag_Assign := Make_Tag_Assignment (Decl);
if Present (Tag_Assign) then if Present (Tag_Assign) then
...@@ -8128,11 +8177,7 @@ package body Freeze is ...@@ -8128,11 +8177,7 @@ package body Freeze is
-- Warn_Overlay -- -- Warn_Overlay --
------------------ ------------------
procedure Warn_Overlay procedure Warn_Overlay (Expr : Node_Id; Typ : Entity_Id; Nam : Entity_Id) is
(Expr : Node_Id;
Typ : Entity_Id;
Nam : Entity_Id)
is
Ent : constant Entity_Id := Entity (Nam); Ent : constant Entity_Id := Entity (Nam);
-- The object to which the address clause applies -- The object to which the address clause applies
......
gcc/ada/gcc-interface/decl.c
...@@ -506,7 +506,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -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 /* Ignore constant definitions already marked with the error node. See
the N_Object_Declaration case of gnat_to_gnu for the rationale. */ the N_Object_Declaration case of gnat_to_gnu for the rationale. */
if (definition if (definition
&& gnu_expr
&& present_gnu_tree (gnat_entity) && present_gnu_tree (gnat_entity)
&& get_gnu_tree (gnat_entity) == error_mark_node) && 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) ...@@ -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 /* If we don't have an initializing expression for the underlying
variable, the initializing expression for the pointer is the variable, the initializing expression for the pointer is the
specified address. Otherwise, we have to make a COMPOUND_EXPR specified address. Otherwise, we have to make a COMPOUND_EXPR
......
gcc/ada/sem_ch13.adb
...@@ -4724,6 +4724,12 @@ package body Sem_Ch13 is ...@@ -4724,6 +4724,12 @@ package body Sem_Ch13 is
Find_Overlaid_Entity (N, O_Ent, Off); 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. -- Overlaying controlled objects is erroneous.
-- Emit warning but continue analysis because program is -- Emit warning but continue analysis because program is
-- itself legal, and back-end must see address clause. -- itself legal, and back-end must see address clause.
...@@ -4743,12 +4749,12 @@ package body Sem_Ch13 is ...@@ -4743,12 +4749,12 @@ package body Sem_Ch13 is
-- Issue an unconditional warning for a constant overlaying -- Issue an unconditional warning for a constant overlaying
-- a variable. For the reverse case, we will issue it only -- 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 Present (O_Ent)
and then Ekind (U_Ent) = E_Constant and then not Overlays_Constant (U_Ent)
and then not Is_Constant_Object (O_Ent) and then Address_Clause_Overlay_Warnings
then then
Error_Msg_N ("??constant overlays a variable", Expr); Error_Msg_N ("??constant overlays a variable", Expr);
...@@ -4767,34 +4773,6 @@ package body Sem_Ch13 is ...@@ -4767,34 +4773,6 @@ package body Sem_Ch13 is
Note_Possible_Modification (Nam, Sure => False); 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 -- Legality checks on the address clause for initialized
-- objects is deferred until the freeze point, because -- objects is deferred until the freeze point, because
-- a subsequent pragma might indicate that the object -- a subsequent pragma might indicate that the object
...@@ -4867,39 +4845,12 @@ package body Sem_Ch13 is ...@@ -4867,39 +4845,12 @@ package body Sem_Ch13 is
-- Furthermore, by removing the test, we handle the -- Furthermore, by removing the test, we handle the
-- aspect case properly. -- aspect case properly.
if Address_Clause_Overlay_Warnings if Present (O_Ent)
and then Present (O_Ent)
and then Is_Object (O_Ent) and then Is_Object (O_Ent)
and then not Is_Generic_Type (Etype (U_Ent))
and then Address_Clause_Overlay_Warnings
then then
if not Is_Generic_Type (Etype (U_Ent)) then Address_Clause_Checks.Append ((N, U_Ent, O_Ent, Off));
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;
end if; end if;
end; end;
......
gcc/ada/sem_util.adb
...@@ -16258,27 +16258,22 @@ package body Sem_Util is ...@@ -16258,27 +16258,22 @@ package body Sem_Util is
-- If we are sure this is a modification from source, and we know -- If we are sure this is a modification from source, and we know
-- this modifies a constant, then give an appropriate warning. -- this modifies a constant, then give an appropriate warning.
if Overlays_Constant (Ent) if Sure
and then (Modification_Comes_From_Source and Sure) and then Modification_Comes_From_Source
and then Overlays_Constant (Ent)
and then Address_Clause_Overlay_Warnings
then then
declare declare
A : constant Node_Id := Address_Clause (Ent); Addr : constant Node_Id := Address_Clause (Ent);
O_Ent : Entity_Id;
Off : Boolean;
begin begin
if Present (A) then Find_Overlaid_Entity (Addr, O_Ent, Off);
declare
Exp : constant Node_Id := Expression (A); Error_Msg_Sloc := Sloc (Addr);
begin Error_Msg_NE
if Nkind (Exp) = N_Attribute_Reference ("??constant& may be modified via address clause#",
and then Attribute_Name (Exp) = Name_Address N, O_Ent);
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;
end; end;
end if; 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