fe.h: Remove global Optimize_Alignment flag, no longer used

2008-04-08  Robert Dewar  <dewar@adacore.com>
	    Gary Dismukes  <dismukes@adacore.com>
	    Javier Miranda  <miranda@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* fe.h: Remove global Optimize_Alignment flag, no longer used

	* layout.adb: Test Optimize_Alignment flags rather than global switch

	* lib.ads, lib.adb: New OA_Setting field in library record

	* lib-load.adb: New OA_Setting field in library record

	* lib-writ.ads, lib-writ.adb (Collect_Withs, Write_With_Lines): Place
	units mentioned in limited_with_ clauses in the ali file, with an
	'Y' marker.
	New Ox fields in U line

	* opt.adb: New flag Optimize_Alignment_Local
	(Check_Policy_List[_Config]): New flags

	* opt.ads (Invalid_Value_Used): New flag
	New switch Optimize_Alignment_Local
	(Warn_On_Parameter_Order): New flag
	(Check_Policy_List[_Config]): New flags

	* ali.ads, ali.adb: Add indicator 'Y' to mark mark the presence of
	limited_with clauses.
	New data structures for Optimize_Alignment

	* bcheck.adb (Check_Consistent_Restriction_No_Default_Initialization):
	New procedure
	(Check_Consistent_Optimize_Alignment): Rework for new structure
	(Check_Consistent_Restrictions): Fix incorrect error message

	sem_ch10.adb (Decorate_Tagged_Type): Set the Parent field of a newly
	created class-wide type (to the Parent field of the specific type).
	(Install_Siblings): Handle properly private_with_clauses on subprogram
	bodies and on generic units.
	(Analyze_With_Clause, Install_Limited_Withed_Unit): Guard against an
	illegal limited_with_clause that names a non-existent package.
	(Check_Body_Required): Determine whether a unit named a limited_with
	clause needs a body.
	(Analyze_Context): A limited_with_clause is illegal on a unit_renaming.
	Capture Optimize_Alignment settings to set new OA_Setting field in
	library record.
	(Build_Limited_Views): Include task and protected type declarations.

	* sem_ch3.ads, sem_ch3.adb (Analyze_Object_Declaration): Handle the
	case of a possible constant redeclaration where the current object is
	an entry index constant.
	(Analyze_Object_Declaration): Generate an error in case of CPP
	class-wide object initialization.
	(Analyze_Object_Declaration): Add extra information on warnings for
	declaration of unconstrained objects.
	(Access_Type_Declaration): Set Associated_Final_Chain to Empty, to avoid
	conflicts with the setting of Stored_Constraint in the case where the
	access type entity has already been created as an E_Incomplete_Type due
	to a limited with clause.
	Use new Is_Standard_Character_Type predicate
	(Analyze_Object_Declaration): Apply access_constant check only after
	expression has been resolved, given that it may be overloaded with
	several access types.
	(Constant_Redeclaration): Additional legality checks for deferred
	constant declarations tha involve anonymous access types and/or null
	exclusion indicators.
	(Analyze_Type_Declaration): Set Optimize_Alignment flags
	(Analyze_Subtype_Declaration): Ditto
	(Analyze_Object_Declaration): Ditto
	(Analyze_Object_Declaration): Don't count tasks in generics
	Change name In_Default_Expression      => In_Spec_Expression
	Change name Analyze_Per_Use_Expression => Preanalyze_Spec_Expression
	Change name Pre_Analyze_And_Resolve    => Preanalyze_And_Resolve
	(Process_Discriminants): Additional check for illegal use of default
	expressions in access discriminant specifications in a type that is not
	explicitly limited.
	(Check_Abstract_Overriding): If an inherited function dispaches on an
	access result, it must be overridden, even if the type is a null
	extension.
	(Derive_Subprogram): The formals of the derived subprogram have the
	names and defaults of the parent subprogram, even if the type is
	obtained from the actual subprogram.
	(Derive_Subprogram): In the presence of interfaces, a formal of an
	inherited operation has the derived type not only if it descends from
	the type of the formal of the parent operation, but also if it
	implements it. This is relevant for the renamings created for the
	primitive operations of the actual for a formal derived type.
	(Is_Progenitor): New predicate, to determine whether the type of a
	formal in the parent operation must be replaced by the derived type.

	* sem_util.ads, sem_util.adb (Has_Overriding_Initialize): Make
	predicate recursive to handle components that have a user-defined
	Initialize procedure. Handle controlled derived types whose ancestor
	has a user-defined Initialize procedured.
	(Note_Possible_Modification): Add Sure parameter, generate warning if
	sure modification of constant
	Use new Is_Standard_Character_Type predicate
	(Find_Parameter_Type): when determining whether a protected operation
	implements an interface operation, retrieve the type of the formal from
	the entity when the formal is an access parameter or an
	anonymous-access-to-subprogram.
	Move Copy_Parameter_List to sem_util, for use when building stubbed
	subprogram bodies.
	(Has_Access_Values): Tagged types now return False
	(Within_HSS_Or_If): New procedure
	(Set_Optimize_Alignment_Flags): New procedure
	Change name In_Default_Expression      => In_Spec_Expression
	Change name Analyze_Per_Use_Expression => Preanalyze_Spec_Expression
	Change name Pre_Analyze_And_Resolve    => Preanalyze_And_Resolve

From-SVN: r134011

1 files changed, 369 insertions, 86 deletions

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index c368058..54925d7 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -205,8 +205,10 @@ package body Sem_Util is
       Rep    : Boolean    := True;
       Warn   : Boolean    := False)
    is
-      Stat : constant Boolean := Is_Static_Expression (N);
-      Rtyp : Entity_Id;
+      Stat   : constant Boolean := Is_Static_Expression (N);
+      R_Stat : constant Node_Id :=
+                 Make_Raise_Constraint_Error (Sloc (N), Reason => Reason);
+      Rtyp   : Entity_Id;
 
    begin
       if No (Typ) then
@@ -225,10 +227,9 @@ package body Sem_Util is
       --  Now we replace the node by an N_Raise_Constraint_Error node
       --  This does not need reanalyzing, so set it as analyzed now.
 
-      Rewrite (N,
-        Make_Raise_Constraint_Error (Sloc (N),
-          Reason => Reason));
+      Rewrite (N, R_Stat);
       Set_Analyzed (N, True);
+
       Set_Etype (N, Rtyp);
       Set_Raises_Constraint_Error (N);
 
@@ -486,9 +487,13 @@ package body Sem_Util is
    --  Start of processing for Build_Actual_Subtype_Of_Component
 
    begin
-      if In_Default_Expression then
+      --  Why the test for Spec_Expression mode here???
+
+      if In_Spec_Expression then
          return Empty;
 
+      --  More commments for the rest of this body would be good ???
+
       elsif Nkind (N) = N_Explicit_Dereference then
          if Is_Composite_Type (T)
            and then not Is_Constrained (T)
@@ -1010,11 +1015,12 @@ package body Sem_Util is
               ("premature usage of incomplete}", N, First_Subtype (T));
          end if;
 
+      --  Need comments for these tests ???
+
       elsif Has_Private_Component (T)
         and then not Is_Generic_Type (Root_Type (T))
-        and then not In_Default_Expression
+        and then not In_Spec_Expression
       then
-
          --  Special case: if T is the anonymous type created for a single
          --  task or protected object, use the name of the source object.
 
@@ -1045,6 +1051,8 @@ package body Sem_Util is
       --  Currently only enabled for VM back-ends for efficiency, should we
       --  enable it more systematically ???
 
+      --  Check for Is_Imported needs commenting below ???
+
       if VM_Target /= No_VM
         and then (Ekind (Ent) = E_Variable
                     or else
@@ -1053,6 +1061,7 @@ package body Sem_Util is
                   Ekind (Ent) = E_Loop_Parameter)
         and then Scope (Ent) /= Empty
         and then not Is_Library_Level_Entity (Ent)
+        and then not Is_Imported (Ent)
       then
          if Is_Subprogram (Scop)
            or else Is_Generic_Subprogram (Scop)
@@ -1103,6 +1112,117 @@ package body Sem_Util is
       end loop;
    end Check_Potentially_Blocking_Operation;
 
+   ------------------------------
+   -- Check_Unprotected_Access --
+   ------------------------------
+
+   procedure Check_Unprotected_Access
+     (Context : Node_Id;
+      Expr    : Node_Id)
+   is
+      Cont_Encl_Typ : Entity_Id;
+      Pref_Encl_Typ : Entity_Id;
+
+      function Enclosing_Protected_Type (Obj : Node_Id) return Entity_Id;
+      --  Check whether Obj is a private component of a protected object.
+      --  Return the protected type where the component resides, Empty
+      --  otherwise.
+
+      function Is_Public_Operation return Boolean;
+      --  Verify that the enclosing operation is callable from outside the
+      --  protected object, to minimize false positives.
+
+      ------------------------------
+      -- Enclosing_Protected_Type --
+      ------------------------------
+
+      function Enclosing_Protected_Type (Obj : Node_Id) return Entity_Id is
+      begin
+         if Is_Entity_Name (Obj) then
+            declare
+               Ent : Entity_Id := Entity (Obj);
+
+            begin
+               --  The object can be a renaming of a private component, use
+               --  the original record component.
+
+               if Is_Prival (Ent) then
+                  Ent := Prival_Link (Ent);
+               end if;
+
+               if Is_Protected_Type (Scope (Ent)) then
+                  return Scope (Ent);
+               end if;
+            end;
+         end if;
+
+         --  For indexed and selected components, recursively check the prefix
+
+         if Nkind_In (Obj, N_Indexed_Component, N_Selected_Component) then
+            return Enclosing_Protected_Type (Prefix (Obj));
+
+         --  The object does not denote a protected component
+
+         else
+            return Empty;
+         end if;
+      end Enclosing_Protected_Type;
+
+      -------------------------
+      -- Is_Public_Operation --
+      -------------------------
+
+      function Is_Public_Operation return Boolean is
+         S : Entity_Id;
+         E : Entity_Id;
+
+      begin
+         S := Current_Scope;
+         while Present (S)
+           and then S /= Pref_Encl_Typ
+         loop
+            if Scope (S) = Pref_Encl_Typ then
+               E := First_Entity (Pref_Encl_Typ);
+               while Present (E)
+                 and then E /= First_Private_Entity (Pref_Encl_Typ)
+               loop
+                  if E = S then
+                     return True;
+                  end if;
+                  Next_Entity (E);
+               end loop;
+            end if;
+
+            S := Scope (S);
+         end loop;
+
+         return False;
+      end Is_Public_Operation;
+
+   --  Start of processing for Check_Unprotected_Access
+
+   begin
+      if Nkind (Expr) = N_Attribute_Reference
+        and then Attribute_Name (Expr) = Name_Unchecked_Access
+      then
+         Cont_Encl_Typ := Enclosing_Protected_Type (Context);
+         Pref_Encl_Typ := Enclosing_Protected_Type (Prefix (Expr));
+
+         --  Check whether we are trying to export a protected component to a
+         --  context with an equal or lower access level.
+
+         if Present (Pref_Encl_Typ)
+           and then No (Cont_Encl_Typ)
+           and then Is_Public_Operation
+           and then Scope_Depth (Pref_Encl_Typ) >=
+                      Object_Access_Level (Context)
+         then
+            Error_Msg_N
+              ("?possible unprotected access to protected data", Expr);
+         end if;
+      end if;
+   end Check_Unprotected_Access;
+
    ---------------
    -- Check_VMS --
    ---------------
@@ -1772,6 +1892,42 @@ package body Sem_Util is
       end if;
    end Conditional_Delay;
 
+   -------------------------
+   -- Copy_Parameter_List --
+   -------------------------
+
+   function Copy_Parameter_List (Subp_Id : Entity_Id) return List_Id is
+      Loc    : constant Source_Ptr := Sloc (Subp_Id);
+      Plist  : List_Id;
+      Formal : Entity_Id;
+
+   begin
+      if No (First_Formal (Subp_Id)) then
+         return No_List;
+      else
+         Plist := New_List;
+         Formal := First_Formal (Subp_Id);
+         while Present (Formal) loop
+            Append
+              (Make_Parameter_Specification (Loc,
+                Defining_Identifier =>
+                  Make_Defining_Identifier (Sloc (Formal),
+                    Chars => Chars (Formal)),
+                In_Present  => In_Present (Parent (Formal)),
+                Out_Present => Out_Present (Parent (Formal)),
+             Parameter_Type =>
+                  New_Reference_To (Etype (Formal), Loc),
+                Expression =>
+                  New_Copy_Tree (Expression (Parent (Formal)))),
+              Plist);
+
+            Next_Formal (Formal);
+         end loop;
+      end if;
+
+      return Plist;
+   end Copy_Parameter_List;
+
    --------------------
    -- Current_Entity --
    --------------------
@@ -2259,26 +2415,6 @@ package body Sem_Util is
       E : constant Entity_Id := Current_Entity_In_Scope (Def_Id);
       S : constant Entity_Id := Current_Scope;
 
-      function Is_Private_Component_Renaming (N : Node_Id) return Boolean;
-      --  Recognize a renaming declaration that is introduced for private
-      --  components of a protected type. We treat these as weak declarations
-      --  so that they are overridden by entities with the same name that
-      --  come from source, such as formals or local variables of a given
-      --  protected declaration.
-
-      -----------------------------------
-      -- Is_Private_Component_Renaming --
-      -----------------------------------
-
-      function Is_Private_Component_Renaming (N : Node_Id) return Boolean is
-      begin
-         return not Comes_From_Source (N)
-           and then not Comes_From_Source (Current_Scope)
-           and then Nkind (N) = N_Object_Renaming_Declaration;
-      end Is_Private_Component_Renaming;
-
-   --  Start of processing for Enter_Name
-
    begin
       Generate_Definition (Def_Id);
 
@@ -2402,7 +2538,29 @@ package body Sem_Util is
          then
             return;
 
-         elsif Is_Private_Component_Renaming (Parent (Def_Id)) then
+         --  If the homograph is a protected component renaming, it should not
+         --  be hiding the current entity. Such renamings are treated as weak
+         --  declarations.
+
+         elsif Is_Prival (E) then
+            Set_Is_Immediately_Visible (E, False);
+
+         --  In this case the current entity is a protected component renaming.
+         --  Perform minimal decoration by setting the scope and return since
+         --  the prival should not be hiding other visible entities.
+
+         elsif Is_Prival (Def_Id) then
+            Set_Scope (Def_Id, Current_Scope);
+            return;
+
+         --  Analogous to privals, the discriminal generated for an entry
+         --  index parameter acts as a weak declaration. Perform minimal
+         --  decoration to avoid bogus errors.
+
+         elsif Is_Discriminal (Def_Id)
+           and then Ekind (Discriminal_Link (Def_Id)) = E_Entry_Index_Parameter
+         then
+            Set_Scope (Def_Id, Current_Scope);
             return;
 
          --  In the body or private part of an instance, a type extension
@@ -2411,7 +2569,7 @@ package body Sem_Util is
          --  of the full type with two components of the same name are not
          --  clear at this point ???
 
-         elsif In_Instance_Not_Visible  then
+         elsif In_Instance_Not_Visible then
             null;
 
          --  When compiling a package body, some child units may have become
@@ -2446,21 +2604,19 @@ package body Sem_Util is
               and then Nkind (Parent (Def_Id)) = N_Private_Type_Declaration
             then
                Error_Msg_N
-                 ("incomplete type cannot be completed" &
-                        " with a private declaration",
-                    Parent (Def_Id));
+                 ("incomplete type cannot be completed with a private " &
+                  "declaration", Parent (Def_Id));
                Set_Is_Immediately_Visible (E, False);
                Set_Full_View (E, Def_Id);
 
+            --  An inherited component of a record conflicts with a new
+            --  discriminant. The discriminant is inserted first in the scope,
+            --  but the error should be posted on it, not on the component.
+
             elsif Ekind (E) = E_Discriminant
               and then Present (Scope (Def_Id))
               and then Scope (Def_Id) /= Current_Scope
             then
-               --  An inherited component of a record conflicts with
-               --  a new discriminant. The discriminant is inserted first
-               --  in the scope, but the error should be posted on it, not
-               --  on the component.
-
                Error_Msg_Sloc := Sloc (Def_Id);
                Error_Msg_N ("& conflicts with declaration#", E);
                return;
@@ -2490,8 +2646,8 @@ package body Sem_Util is
                end if;
             end if;
 
-            if Nkind (Parent (Parent (Def_Id)))
-                 = N_Generic_Subprogram_Declaration
+            if Nkind (Parent (Parent (Def_Id))) =
+                N_Generic_Subprogram_Declaration
               and then Def_Id =
                 Defining_Entity (Specification (Parent (Parent (Def_Id))))
             then
@@ -2922,7 +3078,14 @@ package body Sem_Util is
 
       begin
          Iface_Param := First (Iface_Params);
-         Iface_Typ   := Find_Parameter_Type (Iface_Param);
+
+         if Nkind (Parameter_Type (Iface_Param)) = N_Access_Definition then
+            Iface_Typ :=
+               Designated_Type (Etype (Defining_Identifier (Iface_Param)));
+         else
+            Iface_Typ := Etype (Defining_Identifier (Iface_Param));
+         end if;
+
          Prim_Param  := First (Prim_Params);
 
          --  The first parameter of the potentially overriden subprogram
@@ -3126,8 +3289,12 @@ package body Sem_Util is
       if Nkind (Param) /= N_Parameter_Specification then
          return Empty;
 
+      --  For an access parameter, obtain the type from the formal entity
+      --  itself, because access to subprogram nodes do not carry a type.
+      --  Shouldn't we always use the formal entity ???
+
       elsif Nkind (Parameter_Type (Param)) = N_Access_Definition then
-         return Etype (Subtype_Mark (Parameter_Type (Param)));
+         return Etype (Defining_Identifier (Param));
 
       else
          return Etype (Parameter_Type (Param));
@@ -3293,7 +3460,7 @@ package body Sem_Util is
 
    begin
       Res := Internal_Full_Qualified_Name (E);
-      Store_String_Char (Get_Char_Code (ASCII.nul));
+      Store_String_Char (Get_Char_Code (ASCII.NUL));
       return End_String;
    end Full_Qualified_Name;
 
@@ -3541,9 +3708,9 @@ package body Sem_Util is
            and then not Has_Unknown_Discriminants (Utyp)
            and then not (Ekind (Utyp) = E_String_Literal_Subtype)
       then
-         --  Nothing to do if in default expression
+         --  Nothing to do if in spec expression (why not???)
 
-         if In_Default_Expression then
+         if In_Spec_Expression then
             return Typ;
 
          elsif Is_Private_Type (Typ)
@@ -3661,10 +3828,7 @@ package body Sem_Util is
       --  literals to search. Instead, an N_Character_Literal node is created
       --  with the appropriate Char_Code and Chars fields.
 
-      if Root_Type (T) = Standard_Character
-        or else Root_Type (T) = Standard_Wide_Character
-        or else Root_Type (T) = Standard_Wide_Wide_Character
-      then
+      if Is_Standard_Character_Type (T) then
          Set_Character_Literal_Name (UI_To_CC (Pos));
          return
            Make_Character_Literal (Loc,
@@ -3902,7 +4066,7 @@ package body Sem_Util is
    function Get_Task_Body_Procedure (E : Entity_Id) return Node_Id is
    begin
       --  Note: A task type may be the completion of a private type with
-      --  discriminants. when performing elaboration checks on a task
+      --  discriminants. When performing elaboration checks on a task
       --  declaration, the current view of the type may be the private one,
       --  and the procedure that holds the body of the task is held in its
       --  underlying type.
@@ -4018,9 +4182,17 @@ package body Sem_Util is
             Comp : Entity_Id;
 
          begin
+            --  Loop to Check components
+
             Comp := First_Component_Or_Discriminant (Typ);
             while Present (Comp) loop
-               if Has_Access_Values (Etype (Comp)) then
+
+               --  Check for access component, tag field does not count, even
+               --  though it is implemented internally using an access type.
+
+               if Has_Access_Values (Etype (Comp))
+                 and then Chars (Comp) /= Name_uTag
+               then
                   return True;
                end if;
 
@@ -4526,6 +4698,59 @@ package body Sem_Util is
       end if;
    end Has_Null_Extension;
 
+   -------------------------------
+   -- Has_Overriding_Initialize --
+   -------------------------------
+
+   function Has_Overriding_Initialize (T : Entity_Id) return Boolean is
+      BT   : constant Entity_Id := Base_Type (T);
+      Comp : Entity_Id;
+      P    : Elmt_Id;
+
+   begin
+      if Is_Controlled (BT) then
+
+         --  For derived types, check immediate ancestor, excluding
+         --  Controlled itself.
+
+         if Is_Derived_Type (BT)
+           and then not In_Predefined_Unit (Etype (BT))
+           and then Has_Overriding_Initialize (Etype (BT))
+         then
+            return True;
+
+         elsif Present (Primitive_Operations (BT)) then
+            P := First_Elmt (Primitive_Operations (BT));
+            while Present (P) loop
+               if Chars (Node (P)) = Name_Initialize
+                 and then Comes_From_Source (Node (P))
+               then
+                  return True;
+               end if;
+
+               Next_Elmt (P);
+            end loop;
+         end if;
+
+         return False;
+
+      elsif Has_Controlled_Component (BT) then
+         Comp := First_Component (BT);
+         while Present (Comp) loop
+            if Has_Overriding_Initialize (Etype (Comp)) then
+               return True;
+            end if;
+
+            Next_Component (Comp);
+         end loop;
+
+         return False;
+
+      else
+         return False;
+      end if;
+   end Has_Overriding_Initialize;
+
    --------------------------------------
    -- Has_Preelaborable_Initialization --
    --------------------------------------
@@ -4810,24 +5035,9 @@ package body Sem_Util is
 
          if Has_PE
            and then Is_Controlled (E)
-           and then Present (Primitive_Operations (E))
+           and then Has_Overriding_Initialize (E)
          then
-            declare
-               P : Elmt_Id;
-
-            begin
-               P := First_Elmt (Primitive_Operations (E));
-               while Present (P) loop
-                  if Chars (Node (P)) = Name_Initialize
-                    and then Comes_From_Source (Node (P))
-                  then
-                     Has_PE := False;
-                     exit;
-                  end if;
-
-                  Next_Elmt (P);
-               end loop;
-            end;
+            Has_PE := False;
          end if;
 
       --  Record type has PI if it is non private and all components have PI
@@ -5757,8 +5967,6 @@ package body Sem_Util is
             T := Base_Type (Etyp);
          end loop;
       end if;
-
-      raise Program_Error;
    end Is_Descendent_Of;
 
    --------------
@@ -5920,13 +6128,13 @@ package body Sem_Util is
                              or else No (Expression (Parent (Ent))))
                  and then not Is_Fully_Initialized_Type (Etype (Ent))
 
-                  --  Special VM case for uTag component, which needs to be
-                  --  defined in this case, but is never initialized as VMs
+                  --  Special VM case for tag components, which need to be
+                  --  defined in this case, but are never initialized as VMs
                   --  are using other dispatching mechanisms. Ignore this
-                  --  uninitialized case.
+                  --  uninitialized case. Note that this applies both to the
+                  --  uTag entry and the main vtable pointer (CPP_Class case).
 
-                 and then (VM_Target = No_VM
-                            or else Chars (Ent) /= Name_uTag)
+                 and then (VM_Target = No_VM or else not Is_Tag (Ent))
                then
                   return False;
                end if;
@@ -6176,7 +6384,7 @@ package body Sem_Util is
 
    function Is_OK_Variable_For_Out_Formal (AV : Node_Id) return Boolean is
    begin
-      Note_Possible_Modification (AV);
+      Note_Possible_Modification (AV, Sure => True);
 
       --  We must reject parenthesized variable names. The check for
       --  Comes_From_Source is present because there are currently
@@ -6220,7 +6428,7 @@ package body Sem_Util is
          if Is_Variable (Expression (AV))
            and then Paren_Count (Expression (AV)) = 0
          then
-            Note_Possible_Modification (Expression (AV));
+            Note_Possible_Modification (Expression (AV), Sure => True);
             return True;
 
          --  We also allow a non-parenthesized expression that raises
@@ -7877,7 +8085,7 @@ package body Sem_Util is
    -- Note_Possible_Modification --
    --------------------------------
 
-   procedure Note_Possible_Modification (N : Node_Id) is
+   procedure Note_Possible_Modification (N : Node_Id; Sure : Boolean) is
       Modification_Comes_From_Source : constant Boolean :=
                                          Comes_From_Source (Parent (N));
 
@@ -7993,6 +8201,35 @@ package body Sem_Util is
             end if;
 
             Kill_Checks (Ent);
+
+            --  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 then Sure
+            then
+               declare
+                  A : constant Node_Id := Address_Clause (Ent);
+               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;
+               end;
+            end if;
+
             return;
          end if;
       end loop;
@@ -8045,6 +8282,10 @@ package body Sem_Util is
       if Is_Entity_Name (Obj) then
          E := Entity (Obj);
 
+         if Is_Prival (E) then
+            E := Prival_Link (E);
+         end if;
+
          --  If E is a type then it denotes a current instance. For this case
          --  we add one to the normal accessibility level of the type to ensure
          --  that current instances are treated as always being deeper than
@@ -8881,7 +9122,7 @@ package body Sem_Util is
    -- Scope_Is_Transient --
    ------------------------
 
-   function Scope_Is_Transient  return Boolean is
+   function Scope_Is_Transient return Boolean is
    begin
       return Scope_Stack.Table (Scope_Stack.Last).Is_Transient;
    end Scope_Is_Transient;
@@ -9113,6 +9354,19 @@ package body Sem_Util is
       end if;
    end Set_Next_Actual;
 
+   ----------------------------------
+   -- Set_Optimize_Alignment_Flags --
+   ----------------------------------
+
+   procedure Set_Optimize_Alignment_Flags (E : Entity_Id) is
+   begin
+      if Optimize_Alignment = 'S' then
+         Set_Optimize_Alignment_Space (E);
+      elsif Optimize_Alignment = 'T' then
+         Set_Optimize_Alignment_Time (E);
+      end if;
+   end Set_Optimize_Alignment_Flags;
+
    -----------------------
    -- Set_Public_Status --
    -----------------------
@@ -9120,6 +9374,34 @@ package body Sem_Util is
    procedure Set_Public_Status (Id : Entity_Id) is
       S : constant Entity_Id := Current_Scope;
 
+      function Within_HSS_Or_If (E : Entity_Id) return Boolean;
+      --  Determines if E is defined within handled statement sequence or
+      --  an if statement, returns True if so, False otherwise.
+
+      ----------------------
+      -- Within_HSS_Or_If --
+      ----------------------
+
+      function Within_HSS_Or_If (E : Entity_Id) return Boolean is
+         N : Node_Id;
+      begin
+         N := Declaration_Node (E);
+         loop
+            N := Parent (N);
+
+            if No (N) then
+               return False;
+
+            elsif Nkind_In (N, N_Handled_Sequence_Of_Statements,
+                               N_If_Statement)
+            then
+               return True;
+            end if;
+         end loop;
+      end Within_HSS_Or_If;
+
+   --  Start of processing for Set_Public_Status
+
    begin
       --  Everything in the scope of Standard is public
 
@@ -9131,14 +9413,15 @@ package body Sem_Util is
       elsif not Is_Public (S) then
          return;
 
-      --  An object declaration that occurs in a handled sequence of statements
-      --  is the declaration for a temporary object generated by the expander.
-      --  It never needs to be made public and furthermore, making it public
-      --  can cause back end problems if it is of variable size.
+      --  An object or function declaration that occurs in a handled sequence
+      --  of statements or within an if statement is the declaration for a
+      --  temporary object or local subprogram generated by the expander. It
+      --  never needs to be made public and furthermore, making it public can
+      --  cause back end problems.
 
-      elsif Nkind (Parent (Id)) = N_Object_Declaration
-        and then
-          Nkind (Parent (Parent (Id))) = N_Handled_Sequence_Of_Statements
+      elsif Nkind_In (Parent (Id), N_Object_Declaration,
+                                   N_Function_Specification)
+        and then Within_HSS_Or_If (Id)
       then
          return;