einfo.ads (Overlays_Constant): Document usage for E_Constant.
authorEric Botcazou <ebotcazou@adacore.com>
Thu, 12 Nov 2015 10:59:25 +0000 (10:59 +0000)
committerArnaud Charlet <charlet@gcc.gnu.org>
Thu, 12 Nov 2015 10:59:25 +0000 (11:59 +0100)
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

gcc/ada/ChangeLog
gcc/ada/einfo.ads
gcc/ada/freeze.adb
gcc/ada/gcc-interface/decl.c
gcc/ada/sem_ch13.adb
gcc/ada/sem_util.adb

index f6a3f40c0b901b70ea3aad2284cace71f3735264..ed8f8f058e7f481d549ca2fc32ff1f07ab687411 100644 (file)
@@ -1,3 +1,24 @@
+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
index 8b91ee4ad8fe1a50a28a4281dac48cac8a2d8440..3b52ea553f7854c454b9044035e17ecab18d2a7e 100644 (file)
@@ -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
index 59a49ced0ae9509bc29811d310a523f91a7dd53d..88e785cda397dff0df5c2334d03b10f9c89d039c 100644 (file)
@@ -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 actionsonce 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
 
index 59754b6bc49cf347cbf95fdbc0d96fb8e6756250..0c59ab3aabb3624a72cbc3956791fde545f6b15e 100644 (file)
@@ -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
index f368957c4ae7c91c27405f0fd460847e41285bdf..bbcd7afde76e892c23faeeb4fa4a7dda129fbcb0 100644 (file)
@@ -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;
 
index 89332c44b8c43336676ab3c8f99bdd27da277fd9..2422bb3ec47c7d31371c18a355b8784e472d86da 100644 (file)
@@ -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;