===================================================================
@@ -3638,8 +3638,9 @@
-- Points to the component in the base type.
-- Overlays_Constant (Flag243)
+-- 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 @@
-- 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 @@
--------------------------
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 @@
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 @@
-- 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
===================================================================
@@ -16258,27 +16258,22 @@
-- 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;
===================================================================
@@ -4724,6 +4724,12 @@
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 @@
-- 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 @@
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 @@
-- 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;
===================================================================
@@ -506,7 +506,6 @@
/* 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 @@
}
}
- /* 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