2014-05-21 Robert Dewar <dewar@adacore.com>

	* sem_elab.adb: Minor reformatting.
	* s-taprop.ads: Minor comment fix.
	* sem_ch8.adb (Analyze_Subprogram_Renaming): Remove call to
	Kill_Elaboration_Checks.
	* errout.adb, erroutc.adb: Minor reformatting.

2014-05-21  Thomas Quinot  <quinot@adacore.com>

	* exp_pakd.adb (Byte_Swap): Handle the case of a sub-byte
	component. No byte swapping occurs, but this procedure also takes
	care of appropriately justifying the argument.

2014-05-21  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch6.adb: sem_ch6.adb (Analyze_Aspects_On_Body_Or_Stub):
	New routine.
	(Analyze_Subprogram_Body_Helper): Move the
	analysis of aspect specifications and the processing of the
	subprogram body contract after inlining has taken place.
	(Diagnose_Misplaced_Aspect_Specifications): Removed.

2014-05-21  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Build_Derived_Record_Type): Revert previous change.

2014-05-21  Robert Dewar  <dewar@adacore.com>

	* sem_eval.ads, sem_eval.adb (Why_Not_Static): Messages are not
	continuations any more.

2014-05-21  Ed Schonberg  <schonberg@adacore.com>

	* sinfo.ads, sinfo.adb: New flag Needs_Initialized_Actual,
	present in formal_Private_Definitions and on private extension
	declarations of a formal derived type. Set when the use of the
	formal type in a generic suggests that the actual should be a
	fully initialized type.
	* sem_warn.adb (May_Need_Initialized_Actual): new subprogram
	to indicate that an entity of a generic type has default
	initialization, and that the corresponing actual type in any
	subsequent instantiation should be fully initialized.
	* sem_ch12.adb (Check_Initialized_Type): new subprogram,
	to emit a warning if the actual for a generic type on which
	Needs_Initialized_Actual is set is not a fully initialized type.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@210705 138bc75d-0d04-0410-961f-82ee72b054a4

15 files changed, 505 insertions, 340 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d65b3b0ac4c..f09c608ef4a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,52 @@
 2014-05-21  Robert Dewar  <dewar@adacore.com>
 
+	* sem_elab.adb: Minor reformatting.
+	* s-taprop.ads: Minor comment fix.
+	* sem_ch8.adb (Analyze_Subprogram_Renaming): Remove call to
+	Kill_Elaboration_Checks.
+	* errout.adb, erroutc.adb: Minor reformatting.
+
+2014-05-21  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_pakd.adb (Byte_Swap): Handle the case of a sub-byte
+	component. No byte swapping occurs, but this procedure also takes
+	care of appropriately justifying the argument.
+
+2014-05-21  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_ch6.adb: sem_ch6.adb (Analyze_Aspects_On_Body_Or_Stub):
+	New routine.
+	(Analyze_Subprogram_Body_Helper): Move the
+	analysis of aspect specifications and the processing of the
+	subprogram body contract after inlining has taken place.
+	(Diagnose_Misplaced_Aspect_Specifications): Removed.
+
+2014-05-21  Javier Miranda  <miranda@adacore.com>
+
+	* sem_ch3.adb (Build_Derived_Record_Type): Revert previous change.
+
+2014-05-21  Robert Dewar  <dewar@adacore.com>
+
+	* sem_eval.ads, sem_eval.adb (Why_Not_Static): Messages are not
+	continuations any more.
+
+2014-05-21  Ed Schonberg  <schonberg@adacore.com>
+
+	* sinfo.ads, sinfo.adb: New flag Needs_Initialized_Actual,
+	present in formal_Private_Definitions and on private extension
+	declarations of a formal derived type. Set when the use of the
+	formal type in a generic suggests that the actual should be a
+	fully initialized type.
+	* sem_warn.adb (May_Need_Initialized_Actual): new subprogram
+	to indicate that an entity of a generic type has default
+	initialization, and that the corresponing actual type in any
+	subsequent instantiation should be fully initialized.
+	* sem_ch12.adb (Check_Initialized_Type): new subprogram,
+	to emit a warning if the actual for a generic type on which
+	Needs_Initialized_Actual is set is not a fully initialized type.
+
+2014-05-21  Robert Dewar  <dewar@adacore.com>
+
 	* sem_elab.adb, prj-dect.adb: Minor reformatting.
 
 2014-05-21  Robert Dewar  <dewar@adacore.com>
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 59c37c35d9b..37a1b64d686 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -1010,14 +1010,11 @@ package body Errout is
                exit when
                  Errors.Table (Cur_Msg).Sfile < Errors.Table (Next_Msg).Sfile;
 
-               if Errors.Table (Cur_Msg).Sfile =
-                    Errors.Table (Next_Msg).Sfile
+               if Errors.Table (Cur_Msg).Sfile = Errors.Table (Next_Msg).Sfile
                then
                   exit when Sptr < Errors.Table (Next_Msg).Sptr
-                              or else
-                                (Sptr = Errors.Table (Next_Msg).Sptr
-                                   and then
-                                 Optr < Errors.Table (Next_Msg).Optr);
+                    or else (Sptr = Errors.Table (Next_Msg).Sptr
+                              and then Optr < Errors.Table (Next_Msg).Optr);
                end if;
 
                Prev_Msg := Next_Msg;
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index 7e5b4a04a79..4a107d1df10 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -113,13 +113,13 @@ package body Erroutc is
       N1, N2 : Error_Msg_Id;
 
       procedure Delete_Msg (Delete, Keep : Error_Msg_Id);
-      --  Called to delete message Delete, keeping message Keep. Marks all
-      --  messages of Delete with deleted flag set to True, and also makes sure
-      --  that for the error messages that are retained the preferred message
-      --  is the one retained (we prefer the shorter one in the case where one
-      --  has an Instance tag). Note that we always know that Keep has at least
-      --  as many continuations as Delete (since we always delete the shorter
-      --  sequence).
+      --  Called to delete message Delete, keeping message Keep. Marks msg
+      --  Delete and all its continuations with deleted flag set to True.
+      --  Also makes sure that for the error messages that are retained the
+      --  preferred message is the one retained (we prefer the shorter one in
+      --  the case where one has an Instance tag). Note that we always know
+      --  that Keep has at least as many continuations as Delete (since we
+      --  always delete the shorter sequence).
 
       ----------------
       -- Delete_Msg --
diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb
index b3be6643c12..fcaba801d0d 100644
--- a/gcc/ada/exp_pakd.adb
+++ b/gcc/ada/exp_pakd.adb
@@ -576,20 +576,26 @@ package body Exp_Pakd is
       Shift   : Uint;
 
    begin
-      pragma Assert (T_Size > 8);
+      if T_Size <= 8 then
+         Swap_F := Empty;
+         Swap_T := RTE (RE_Unsigned_8);
 
-      if T_Size <= 16 then
-         Swap_RE := RE_Bswap_16;
+      else
+         if T_Size <= 16 then
+            Swap_RE := RE_Bswap_16;
+
+         elsif T_Size <= 32 then
+            Swap_RE := RE_Bswap_32;
+
+         else pragma Assert (T_Size <= 64);
+            Swap_RE := RE_Bswap_64;
+         end if;
 
-      elsif T_Size <= 32 then
-         Swap_RE := RE_Bswap_32;
+         Swap_F := RTE (Swap_RE);
+         Swap_T := Etype (Swap_F);
 
-      else pragma Assert (T_Size <= 64);
-         Swap_RE := RE_Bswap_64;
       end if;
 
-      Swap_F := RTE (Swap_RE);
-      Swap_T := Etype (Swap_F);
       Shift := Esize (Swap_T) - T_Size;
 
       Arg := RJ_Unchecked_Convert_To (Swap_T, N);
@@ -601,10 +607,14 @@ package body Exp_Pakd is
              Right_Opnd => Make_Integer_Literal (Loc, Shift));
       end if;
 
-      Swapped :=
-        Make_Function_Call (Loc,
-          Name                   => New_Occurrence_Of (Swap_F, Loc),
-          Parameter_Associations => New_List (Arg));
+      if Present (Swap_F) then
+         Swapped :=
+           Make_Function_Call (Loc,
+             Name                   => New_Occurrence_Of (Swap_F, Loc),
+             Parameter_Associations => New_List (Arg));
+      else
+         Swapped := Arg;
+      end if;
 
       if Right_Justify and then Shift > Uint_0 then
          Swapped :=
diff --git a/gcc/ada/s-taprop.ads b/gcc/ada/s-taprop.ads
index 6f15ce7f55e..efe9dd265a1 100644
--- a/gcc/ada/s-taprop.ads
+++ b/gcc/ada/s-taprop.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -324,15 +324,15 @@ package System.Task_Primitives.Operations is
       Prio : System.Any_Priority;
       Loss_Of_Inheritance : Boolean := False);
    pragma Inline (Set_Priority);
-   --  Set the priority of the task specified by T to T.Current_Priority. The
-   --  priority set is what would correspond to the Ada concept of "base
-   --  priority" in the terms of the lower layer system, but the operation may
-   --  be used by the upper layer to implement changes in "active priority"
-   --  that are not due to lock effects. The effect should be consistent with
-   --  the Ada Reference Manual. In particular, when a task lowers its
-   --  priority due to the loss of inherited priority, it goes at the head of
-   --  the queue for its new priority (RM D.2.2 par 9). Loss_Of_Inheritance
-   --  helps the underlying implementation to do it right when the OS doesn't.
+   --  Set the priority of the task specified by T to Prio. The priority set
+   --  is what would correspond to the Ada concept of "base priority" in the
+   --  terms of the lower layer system, but the operation may be used by the
+   --  upper layer to implement changes in "active priority" that are not due
+   --  to lock effects. The effect should be consistent with the Ada Reference
+   --  Manual. In particular, when a task lowers its priority due to the loss
+   --  of inherited priority, it goes at the head of the queue for its new
+   --  priority (RM D.2.2 par 9). Loss_Of_Inheritance helps the underlying
+   --  implementation to do it right when the OS doesn't.
 
    function Get_Priority (T : ST.Task_Id) return System.Any_Priority;
    pragma Inline (Get_Priority);
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 0874a031fbc..057f088cd70 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -9941,6 +9941,58 @@ package body Sem_Ch12 is
       --  List of primitives made temporarily visible in the instantiation
       --  to match the visibility of the formal type
 
+      procedure Check_Initialized_Types;
+      --  In a generic package body, an entity of a generic private type may
+      --  appear uninitialized. This is suspicious, unless the actual is a
+      --  fully initialized type.
+
+      procedure Check_Initialized_Types is
+         Decl   : Node_Id;
+         Formal : Entity_Id;
+         Actual : Entity_Id;
+
+      begin
+         Decl := First (Generic_Formal_Declarations (Gen_Decl));
+         while Present (Decl) loop
+            if (Nkind (Decl) = N_Private_Extension_Declaration
+                 and then Needs_Initialized_Actual (Decl))
+
+              or else (Nkind (Decl) = N_Formal_Type_Declaration
+                  and then
+                    Nkind (Formal_Type_Definition (Decl)) =
+                      N_Formal_Private_Type_Definition
+                  and then Needs_Initialized_Actual
+                     (Formal_Type_Definition (Decl)))
+            then
+               Formal := Defining_Identifier (Decl);
+               Actual := First_Entity (Act_Decl_Id);
+
+               --  For each formal there is a subtype declaration that renames
+               --  the actual and has the same name as the formal.
+
+               while Present (Actual) loop
+                  exit when Ekind (Actual) = E_Package
+                    and then Present (Renamed_Object (Actual));
+
+                  if Chars (Actual) = Chars (Formal)
+                    and then not Is_Scalar_Type (Actual)
+                    and then not Is_Fully_Initialized_Type (Actual)
+                    and then Warn_On_No_Value_Assigned
+                  then
+                     Error_Msg_NE
+                       ("from its use in generic unit, actual for&"
+                          & " should be fully initialized type?",
+                          Actual, Formal);
+                     exit;
+                  end if;
+
+                  Next_Entity (Actual);
+               end loop;
+            end if;
+
+            Next (Decl);
+         end loop;
+      end Check_Initialized_Types;
    begin
       Gen_Body_Id := Corresponding_Body (Gen_Decl);
 
@@ -10013,6 +10065,7 @@ package body Sem_Ch12 is
 
          Set_Corresponding_Spec (Act_Body, Act_Decl_Id);
          Check_Generic_Actuals (Act_Decl_Id, False);
+         Check_Initialized_Types;
 
          --  Install primitives hidden at the point of the instantiation but
          --  visible when processing the generic formals
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 969674a1dd2..5db4bb76313 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -919,19 +919,16 @@ package body Sem_Ch3 is
       --  include an expression that is an allocator, whose expansion needs the
       --  proper Master for the created tasks.
 
-      if Nkind (Related_Nod) = N_Object_Declaration
-        and then Expander_Active
+      if Nkind (Related_Nod) = N_Object_Declaration and then Expander_Active
       then
-         if Is_Interface (Desig_Type)
-           and then Is_Limited_Record (Desig_Type)
+         if Is_Interface (Desig_Type) and then Is_Limited_Record (Desig_Type)
          then
             Build_Class_Wide_Master (Anon_Type);
 
          --  Similarly, if the type is an anonymous access that designates
          --  tasks, create a master entity for it in the current context.
 
-         elsif Has_Task (Desig_Type)
-           and then Comes_From_Source (Related_Nod)
+         elsif Has_Task (Desig_Type) and then Comes_From_Source (Related_Nod)
          then
             Build_Master_Entity (Defining_Identifier (Related_Nod));
             Build_Master_Renaming (Anon_Type);
@@ -1205,8 +1202,7 @@ package body Sem_Ch3 is
             --  use previous subprogram type as the designated type, and then
             --  remove scope added above.
 
-            if ASIS_Mode
-              and then Present (Scope (Defining_Identifier (F)))
+            if ASIS_Mode and then Present (Scope (Defining_Identifier (F)))
             then
                Set_Etype                    (T_Name, T_Name);
                Init_Size_Align              (T_Name);
@@ -1355,8 +1351,7 @@ package body Sem_Ch3 is
       --  its own context, allowing the following circularity that cannot be
       --  detected earlier
 
-      elsif Is_Class_Wide_Type (Full_Desig)
-        and then Etype (Full_Desig) = T
+      elsif Is_Class_Wide_Type (Full_Desig) and then Etype (Full_Desig) = T
       then
          Error_Msg_N
            ("access type cannot designate its own classwide type", S);
@@ -1755,9 +1750,8 @@ package body Sem_Ch3 is
 
          case Nkind (Constr) is
             when N_Attribute_Reference =>
-               return
-                 Attribute_Name (Constr) = Name_Access
-                   and then Prefix (Constr) = Scope (Entity (Prefix (Constr)));
+               return Attribute_Name (Constr) = Name_Access
+                 and then Prefix (Constr) = Scope (Entity (Prefix (Constr)));
 
             when N_Discriminant_Association =>
                return Denotes_Discriminant (Expression (Constr));
@@ -2319,9 +2313,7 @@ package body Sem_Ch3 is
             --  ??? a cleaner approach may be possible and/or this solution
             --  could be extended to general-purpose late primitives, TBD.
 
-            if not ASIS_Mode
-              and then not Body_Seen
-              and then not Is_Body (Decl)
+            if not ASIS_Mode and then not Body_Seen and then not Is_Body (Decl)
             then
                Body_Seen := True;
 
@@ -2472,8 +2464,7 @@ package body Sem_Ch3 is
       --  imported through a LIMITED WITH clause, it appears as incomplete
       --  but has no full view.
 
-      if Ekind (Prev) = E_Incomplete_Type
-        and then Present (Full_View (Prev))
+      if Ekind (Prev) = E_Incomplete_Type and then Present (Full_View (Prev))
       then
          T := Full_View (Prev);
       else
@@ -3196,7 +3187,6 @@ package body Sem_Ch3 is
 
          if Present (Prev_Entity)
            and then
-
              --  If the homograph is an implicit subprogram, it is overridden
              --  by the current declaration.
 
@@ -3274,12 +3264,11 @@ package body Sem_Ch3 is
       --  Ada 2005 (AI-231): Propagate the null-excluding attribute and carry
       --  out some static checks
 
-      if Ada_Version >= Ada_2005
-        and then Can_Never_Be_Null (T)
-      then
+      if Ada_Version >= Ada_2005 and then Can_Never_Be_Null (T) then
+
          --  In case of aggregates we must also take care of the correct
          --  initialization of nested aggregates bug this is done at the
-         --  point of the analysis of the aggregate (see sem_aggr.adb)
+         --  point of the analysis of the aggregate (see sem_aggr.adb).
 
          if Present (Expression (N))
            and then Nkind (Expression (N)) = N_Aggregate
@@ -3523,9 +3512,7 @@ package body Sem_Ch3 is
                Set_Current_Value (Id, E);
             end if;
 
-         elsif Is_Scalar_Type (T)
-           and then Is_OK_Static_Expression (E)
-         then
+         elsif Is_Scalar_Type (T) and then Is_OK_Static_Expression (E) then
             Set_Is_Known_Valid (Id);
          end if;
 
@@ -3534,9 +3521,7 @@ package body Sem_Ch3 is
          if Is_Access_Type (T) then
             if Known_Non_Null (E) then
                Set_Is_Known_Non_Null (Id, True);
-            elsif Known_Null (E)
-              and then not Can_Never_Be_Null (Id)
-            then
+            elsif Known_Null (E) and then not Can_Never_Be_Null (Id) then
                Set_Is_Known_Null (Id, True);
             end if;
          end if;
@@ -3973,9 +3958,7 @@ package body Sem_Ch3 is
          declare
             Val : constant Node_Id := Constant_Value (Entity (E));
          begin
-            if Present (Val)
-              and then Nkind (Val) = N_String_Literal
-            then
+            if Present (Val) and then Nkind (Val) = N_String_Literal then
                Rewrite (E, New_Copy (Val));
             end if;
          end;
@@ -4027,8 +4010,7 @@ package body Sem_Ch3 is
 
       --  Deal with setting In_Private_Part flag if in private part
 
-      if Ekind (Scope (Id)) = E_Package
-        and then In_Private_Part (Scope (Id))
+      if Ekind (Scope (Id)) = E_Package and then In_Private_Part (Scope (Id))
       then
          Set_In_Private_Part (Id);
       end if;
@@ -4125,8 +4107,8 @@ package body Sem_Ch3 is
 
             pragma Assert (Prev = T
               or else (Ekind (Prev) = E_Incomplete_Type
-                         and then Present (Full_View (Prev))
-                         and then Full_View (Prev) = T));
+                        and then Present (Full_View (Prev))
+                        and then Full_View (Prev) = T));
          end;
       end if;
 
@@ -4211,9 +4193,7 @@ package body Sem_Ch3 is
       --  Ada 2005 (AI-443): Synchronized private extension or a rewritten
       --  synchronized formal derived type.
 
-      if Ada_Version >= Ada_2005
-        and then Synchronized_Present (N)
-      then
+      if Ada_Version >= Ada_2005 and then Synchronized_Present (N) then
          Set_Is_Limited_Record (T);
 
          --  Formal derived type case
@@ -4224,9 +4204,9 @@ package body Sem_Ch3 is
             --  interface.
 
             if (not Is_Tagged_Type (Parent_Type)
-                  or else not Is_Limited_Type (Parent_Type))
+                 or else not Is_Limited_Type (Parent_Type))
               and then
-               (not Is_Interface (Parent_Type)
+                (not Is_Interface (Parent_Type)
                   or else not Is_Synchronized_Interface (Parent_Type))
             then
                Error_Msg_NE ("parent type of & must be tagged limited " &
@@ -4264,8 +4244,7 @@ package body Sem_Ch3 is
          else
             if not Is_Interface (Parent_Type)
               or else (not Is_Limited_Interface (Parent_Type)
-                         and then
-                       not Is_Synchronized_Interface (Parent_Type))
+                        and then not Is_Synchronized_Interface (Parent_Type))
             then
                Error_Msg_NE
                  ("parent type of & must be limited interface", N, T);
@@ -4459,9 +4438,7 @@ package body Sem_Ch3 is
          --  Subtype of unconstrained array without constraint is not allowed
          --  in SPARK.
 
-         if Is_Array_Type (T)
-           and then not Is_Constrained (T)
-         then
+         if Is_Array_Type (T) and then not Is_Constrained (T) then
             Check_SPARK_Restriction
               ("subtype of unconstrained array must have constraint", N);
          end if;
@@ -4748,11 +4725,11 @@ package body Sem_Ch3 is
 
       if Present (Generic_Parent_Type (N))
         and then
-          (Nkind
-            (Parent (Generic_Parent_Type (N))) /= N_Formal_Type_Declaration
+          (Nkind (Parent (Generic_Parent_Type (N))) /=
+                                              N_Formal_Type_Declaration
             or else Nkind
-              (Formal_Type_Definition (Parent (Generic_Parent_Type (N))))
-                /= N_Formal_Private_Type_Definition)
+              (Formal_Type_Definition (Parent (Generic_Parent_Type (N)))) /=
+                                              N_Formal_Private_Type_Definition)
       then
          if Is_Tagged_Type (Id) then
 
@@ -4773,9 +4750,7 @@ package body Sem_Ch3 is
          end if;
       end if;
 
-      if Is_Private_Type (T)
-        and then Present (Full_View (T))
-      then
+      if Is_Private_Type (T) and then Present (Full_View (T)) then
          Conditional_Delay (Id, Full_View (T));
 
       --  The subtypes of components or subcomponents of protected types
@@ -4807,8 +4782,7 @@ package body Sem_Ch3 is
 
          --  In the array case, check compatibility for each index
 
-         elsif Is_Array_Type (Etype (Id))
-           and then Present (First_Index (Id))
+         elsif Is_Array_Type (Etype (Id)) and then Present (First_Index (Id))
          then
             --  This really should be a subprogram that finds the indications
             --  to check???
@@ -4823,7 +4797,7 @@ package body Sem_Ch3 is
             begin
                while Present (Subt_Index) loop
                   if ((Nkind (Subt_Index) = N_Identifier
-                         and then Ekind (Entity (Subt_Index)) in Scalar_Kind)
+                        and then Ekind (Entity (Subt_Index)) in Scalar_Kind)
                        or else Nkind (Subt_Index) = N_Subtype_Indication)
                     and then
                       Nkind (Scalar_Range (Etype (Subt_Index))) = N_Range
@@ -5230,9 +5204,7 @@ package body Sem_Ch3 is
       --  Ada 2005 (AI-231): Propagate the null-excluding attribute to the
       --  array type to ensure that objects of this type are initialized.
 
-      if Ada_Version >= Ada_2005
-        and then Can_Never_Be_Null (Element_Type)
-      then
+      if Ada_Version >= Ada_2005 and then Can_Never_Be_Null (Element_Type) then
          Set_Can_Never_Be_Null (T);
 
          if Null_Exclusion_Present (Component_Definition (Def))
@@ -5292,9 +5264,7 @@ package body Sem_Ch3 is
       --  types created for packed entities do not need such, they are
       --  compatible with the user-defined type.
 
-      if Number_Dimensions (T) = 1
-         and then not Is_Packed_Array_Type (T)
-      then
+      if Number_Dimensions (T) = 1 and then not Is_Packed_Array_Type (T) then
          New_Concatenation_Op (T);
       end if;
 
@@ -5587,6 +5557,8 @@ package body Sem_Ch3 is
       if Null_Exclusion_Present (Type_Definition (N)) then
          Set_Can_Never_Be_Null (Derived_Type);
 
+         --  What is with the "AND THEN FALSE" here ???
+
          if Can_Never_Be_Null (Parent_Type)
            and then False
          then
@@ -7453,20 +7425,6 @@ package body Sem_Ch3 is
         and then Has_Discriminants (Parent_Type)
       then
          Parent_Base := Base_Type (Full_View (Parent_Type));
-
-      --  Handle a derived type which is the full view of a private type not
-      --  defined in a generic unit which is derived from a private type with
-      --  discriminants whose full view is a non-tagged record type.
-
-      elsif not Inside_A_Generic
-        and then Ekind (Parent_Type) = E_Private_Type
-        and then Has_Discriminants (Parent_Type)
-        and then Present (Full_View (Parent_Type))
-        and then Is_Record_Type (Full_View (Parent_Type))
-        and then not Is_Tagged_Type (Full_View (Parent_Type))
-        and then Has_Private_Declaration (Derived_Type)
-      then
-         Parent_Base := Base_Type (Full_View (Parent_Type));
       else
          Parent_Base := Base_Type (Parent_Type);
       end if;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index a3364b8e832..5305b31d5fe 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2147,6 +2147,10 @@ package body Sem_Ch6 is
       --  chained beyond that point. It is initialized to Empty to deal with
       --  the case where there is no separate spec.
 
+      procedure Analyze_Aspects_On_Body_Or_Stub;
+      --  Analyze the aspect specifications of a subprogram body [stub]. It is
+      --  assumed that N has aspects.
+
       procedure Check_Anonymous_Return;
       --  Ada 2005: if a function returns an access type that denotes a task,
       --  or a type that contains tasks, we must create a master entity for
@@ -2169,11 +2173,6 @@ package body Sem_Ch6 is
       --  verify that a function ends with a RETURN and that a procedure does
       --  not contain any RETURN.
 
-      procedure Diagnose_Misplaced_Aspect_Specifications;
-      --  It is known that subprogram body N has aspects, but they are not
-      --  properly placed. Provide specific error messages depending on the
-      --  aspects involved.
-
       function Disambiguate_Spec return Entity_Id;
       --  When a primitive is declared between the private view and the full
       --  view of a concurrent type which implements an interface, a special
@@ -2203,6 +2202,127 @@ package body Sem_Ch6 is
       --  indicator, check that it is consistent with the known status of the
       --  entity.
 
+      -------------------------------------
+      -- Analyze_Aspects_On_Body_Or_Stub --
+      -------------------------------------
+
+      procedure Analyze_Aspects_On_Body_Or_Stub is
+         procedure Diagnose_Misplaced_Aspects;
+         --  Subprogram body [stub] N has aspects, but they are not properly
+         --  placed. Provide precise diagnostics depending on the aspects
+         --  involved.
+
+         --------------------------------
+         -- Diagnose_Misplaced_Aspects --
+         --------------------------------
+
+         procedure Diagnose_Misplaced_Aspects is
+            Asp     : Node_Id;
+            Asp_Nam : Name_Id;
+            Asp_Id  : Aspect_Id;
+            --  The current aspect along with its name and id
+
+            procedure SPARK_Aspect_Error (Ref_Nam : Name_Id);
+            --  Emit an error message concerning SPARK aspect Asp. Ref_Nam is
+            --  the name of the refined version of the aspect.
+
+            ------------------------
+            -- SPARK_Aspect_Error --
+            ------------------------
+
+            procedure SPARK_Aspect_Error (Ref_Nam : Name_Id) is
+            begin
+               --  The corresponding spec already contains the aspect in
+               --  question and the one appearing on the body must be the
+               --  refined form:
+
+               --    procedure P with Global ...;
+               --    procedure P with Global ... is ... end P;
+               --                     ^
+               --                     Refined_Global
+
+               if Has_Aspect (Spec_Id, Asp_Id) then
+                  Error_Msg_Name_1 := Asp_Nam;
+
+                  --  Subunits cannot carry aspects that apply to a subprogram
+                  --  declaration.
+
+                  if Nkind (Parent (N)) = N_Subunit then
+                     Error_Msg_N ("aspect % cannot apply to a subunit", Asp);
+
+                  else
+                     Error_Msg_Name_2 := Ref_Nam;
+                     Error_Msg_N ("aspect % should be %", Asp);
+                  end if;
+
+               --  Otherwise the aspect must appear in the spec, not in the
+               --  body:
+
+               --    procedure P;
+               --    procedure P with Global ... is ... end P;
+
+               else
+                  Error_Msg_N
+                    ("aspect specification must appear in subprogram "
+                     & "declaration", Asp);
+               end if;
+            end SPARK_Aspect_Error;
+
+         --  Start of processing for Diagnose_Misplaced_Aspects
+
+         begin
+            --  Iterate over the aspect specifications and emit specific errors
+            --  where applicable.
+
+            Asp := First (Aspect_Specifications (N));
+            while Present (Asp) loop
+               Asp_Nam := Chars (Identifier (Asp));
+               Asp_Id  := Get_Aspect_Id (Asp_Nam);
+
+               --  Do not emit errors on aspects that can appear on a
+               --  subprogram body. This scenario occurs when the aspect
+               --  specification list contains both misplaced and properly
+               --  placed aspects.
+
+               if Aspect_On_Body_Or_Stub_OK (Asp_Id) then
+                  null;
+
+               --  Special diagnostics for SPARK aspects
+
+               elsif Asp_Nam = Name_Depends then
+                  SPARK_Aspect_Error (Name_Refined_Depends);
+
+               elsif Asp_Nam = Name_Global then
+                  SPARK_Aspect_Error (Name_Refined_Global);
+
+               elsif Asp_Nam = Name_Post then
+                  SPARK_Aspect_Error (Name_Refined_Post);
+
+               else
+                  Error_Msg_N
+                    ("aspect specification must appear in subprogram "
+                     & "declaration", Asp);
+               end if;
+
+               Next (Asp);
+            end loop;
+         end Diagnose_Misplaced_Aspects;
+
+      --  Start of processing for Analyze_Aspects_On_Body_Or_Stub
+
+      begin
+         --  Language-defined aspects cannot be associated with a subprogram
+         --  body [stub] if the subprogram has a spec. Certain implementation
+         --  defined aspects are allowed to break this rule (for list, see
+         --  table Aspect_On_Body_Or_Stub_OK).
+
+         if Present (Spec_Id) and then not Aspects_On_Body_Or_Stub_OK (N) then
+            Diagnose_Misplaced_Aspects;
+         else
+            Analyze_Aspect_Specifications (N, Body_Id);
+         end if;
+      end Analyze_Aspects_On_Body_Or_Stub;
+
       ----------------------------
       -- Check_Anonymous_Return --
       ----------------------------
@@ -2455,99 +2575,6 @@ package body Sem_Ch6 is
          end if;
       end Check_Missing_Return;
 
-      ----------------------------------------------
-      -- Diagnose_Misplaced_Aspect_Specifications --
-      ----------------------------------------------
-
-      procedure Diagnose_Misplaced_Aspect_Specifications is
-         Asp     : Node_Id;
-         Asp_Nam : Name_Id;
-         Asp_Id  : Aspect_Id;
-         --  The current aspect along with its name and id
-
-         procedure SPARK_Aspect_Error (Ref_Nam : Name_Id);
-         --  Emit an error message concerning SPARK aspect Asp. Ref_Nam is the
-         --  name of the refined version of the aspect.
-
-         ------------------------
-         -- SPARK_Aspect_Error --
-         ------------------------
-
-         procedure SPARK_Aspect_Error (Ref_Nam : Name_Id) is
-         begin
-            --  The corresponding spec already contains the aspect in question
-            --  and the one appearing on the body must be the refined form:
-
-            --    procedure P with Global ...;
-            --    procedure P with Global ... is ... end P;
-            --                     ^
-            --                     Refined_Global
-
-            if Has_Aspect (Spec_Id, Asp_Id) then
-               Error_Msg_Name_1 := Asp_Nam;
-
-               --  Subunits cannot carry aspects that apply to a subprogram
-               --  declaration.
-
-               if Nkind (Parent (N)) = N_Subunit then
-                  Error_Msg_N ("aspect % cannot apply to a subunit", Asp);
-
-               else
-                  Error_Msg_Name_2 := Ref_Nam;
-                  Error_Msg_N ("aspect % should be %", Asp);
-               end if;
-
-            --  Otherwise the aspect must appear in the spec, not in the body:
-
-            --    procedure P;
-            --    procedure P with Global ... is ... end P;
-
-            else
-               Error_Msg_N
-                 ("aspect specification must appear in subprogram declaration",
-                  Asp);
-            end if;
-         end SPARK_Aspect_Error;
-
-      --  Start of processing for Diagnose_Misplaced_Aspect_Specifications
-
-      begin
-         --  Iterate over the aspect specifications and emit specific errors
-         --  where applicable.
-
-         Asp := First (Aspect_Specifications (N));
-         while Present (Asp) loop
-            Asp_Nam := Chars (Identifier (Asp));
-            Asp_Id  := Get_Aspect_Id (Asp_Nam);
-
-            --  Do not emit errors on aspects that can appear on a subprogram
-            --  body. This scenario occurs when the aspect specification list
-            --  contains both misplaced and properly placed aspects.
-
-            if Aspect_On_Body_Or_Stub_OK (Asp_Id) then
-               null;
-
-            --  Special diagnostics for SPARK aspects
-
-            elsif Asp_Nam = Name_Depends then
-               SPARK_Aspect_Error (Name_Refined_Depends);
-
-            elsif Asp_Nam = Name_Global then
-               SPARK_Aspect_Error (Name_Refined_Global);
-
-            elsif Asp_Nam = Name_Post then
-               SPARK_Aspect_Error (Name_Refined_Post);
-
-            else
-               Error_Msg_N
-                 ("aspect specification must appear in subprogram declaration",
-                  Asp);
-            end if;
-
-            Next (Asp);
-         end loop;
-      end Diagnose_Misplaced_Aspect_Specifications;
-
       -----------------------
       -- Disambiguate_Spec --
       -----------------------
@@ -2948,21 +2975,6 @@ package body Sem_Ch6 is
          end if;
       end if;
 
-      --  Language-defined aspects cannot appear on a subprogram body [stub] if
-      --  the subprogram has a spec. Certain implementation-defined aspects are
-      --  allowed to break this rule (see table Aspect_On_Body_Or_Stub_OK).
-
-      if Has_Aspects (N) then
-         if Present (Spec_Id)
-           and then not Aspects_On_Body_Or_Stub_OK (N)
-         then
-            Diagnose_Misplaced_Aspect_Specifications;
-
-         else
-            Analyze_Aspect_Specifications (N, Body_Id);
-         end if;
-      end if;
-
       --  Previously we scanned the body to look for nested subprograms, and
       --  rejected an inline directive if nested subprograms were present,
       --  because the back-end would generate conflicting symbols for the
@@ -3299,6 +3311,17 @@ package body Sem_Ch6 is
       Check_Eliminated (Body_Id);
 
       if Nkind (N) = N_Subprogram_Body_Stub then
+
+         --  Analyze any aspect specifications that appear on the subprogram
+         --  body stub.
+
+         if Has_Aspects (N) then
+            Analyze_Aspects_On_Body_Or_Stub;
+         end if;
+
+         --  Stop the analysis now as the stub cannot be inlined, plus it does
+         --  not have declarative or statement lists.
+
          return;
       end if;
 
@@ -3372,16 +3395,6 @@ package body Sem_Ch6 is
       HSS := Handled_Statement_Sequence (N);
       Set_Actual_Subtypes (N, Current_Scope);
 
-      --  Deal with [refined] preconditions, postconditions, Contract_Cases,
-      --  invariants and predicates associated with the body and its spec.
-      --  Note that this is not pure expansion as Expand_Subprogram_Contract
-      --  prepares the contract assertions for generic subprograms or for ASIS.
-      --  Do not generate contract checks in SPARK mode.
-
-      if not GNATprove_Mode then
-         Expand_Subprogram_Contract (N, Spec_Id, Body_Id);
-      end if;
-
       --  Add a declaration for the Protection object, renaming declarations
       --  for discriminals and privals and finally a declaration for the entry
       --  family index (if applicable). This form of early expansion is done
@@ -3409,6 +3422,22 @@ package body Sem_Ch6 is
          Exchange_Limited_Views (Spec_Id);
       end if;
 
+      --  Analyze any aspect specifications that appear on the subprogram body
+
+      if Has_Aspects (N) then
+         Analyze_Aspects_On_Body_Or_Stub;
+      end if;
+
+      --  Deal with [refined] preconditions, postconditions, Contract_Cases,
+      --  invariants and predicates associated with the body and its spec.
+      --  Note that this is not pure expansion as Expand_Subprogram_Contract
+      --  prepares the contract assertions for generic subprograms or for ASIS.
+      --  Do not generate contract checks in SPARK mode.
+
+      if not GNATprove_Mode then
+         Expand_Subprogram_Contract (N, Spec_Id, Body_Id);
+      end if;
+
       --  Analyze the declarations (this call will analyze the precondition
       --  Check pragmas we prepended to the list, as well as the declaration
       --  of the _Postconditions procedure).
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index a727679270d..4c5147c9a76 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -2505,12 +2505,18 @@ package body Sem_Ch8 is
          end if;
       end if;
 
+      --  At this point, we used to have the following, but we removed it
+      --  because it was certainly wrong for generic formal parameters in
+      --  at least some cases, causing elaboration checks to be skipped.
+      --  Possibly it is helpful in some other cases, but it caused no
+      --  regressions to remove it completely.
+
       --  There is no need for elaboration checks on the new entity, which may
       --  be called before the next freezing point where the body will appear.
       --  Elaboration checks refer to the real entity, not the one created by
       --  the renaming declaration.
 
-      Set_Kill_Elaboration_Checks (New_S, True);
+      --  Set_Kill_Elaboration_Checks (New_S, True);
 
       if Etype (Nam) = Any_Type then
          Set_Has_Completion (New_S);
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index 19c6aa29445..fa39312a8ef 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -578,16 +578,15 @@ package body Sem_Elab is
       if Nkind (Decl) = N_Subprogram_Body then
          Body_Acts_As_Spec := True;
 
-      elsif Nkind (Decl) = N_Subprogram_Declaration
-        or else Nkind (Decl) = N_Subprogram_Body_Stub
+      elsif Nkind_In (Decl, N_Subprogram_Declaration, N_Subprogram_Body_Stub)
         or else Inst_Case
       then
          Body_Acts_As_Spec := False;
 
-      --  If we have none of an instantiation, subprogram body or
-      --  subprogram declaration, then it is not a case that we want
-      --  to check. (One case is a call to a generic formal subprogram,
-      --  where we do not want the check in the template).
+      --  If we have none of an instantiation, subprogram body or subprogram
+      --  declaration, then it is not a case that we want to check. (One case
+      --  is a call to a generic formal subprogram, where we do not want the
+      --  check in the template).
 
       else
          return;
@@ -605,7 +604,7 @@ package body Sem_Elab is
 
          exit when Is_Compilation_Unit (E_Scope)
            and then (Is_Child_Unit (E_Scope)
-                       or else Scope (E_Scope) = Standard_Standard);
+                      or else Scope (E_Scope) = Standard_Standard);
 
          --  If we did not find a compilation unit, other than standard,
          --  then nothing to check (happens in some instantiation cases)
@@ -633,17 +632,15 @@ package body Sem_Elab is
       --  However, this assumption is only valid if we are in static mode.
 
       if not Dynamic_Elaboration_Checks
-        and then Instantiation_Depth (Sloc (Ent)) >
-                 Instantiation_Depth (Sloc (N))
+        and then
+          Instantiation_Depth (Sloc (Ent)) > Instantiation_Depth (Sloc (N))
       then
          return;
       end if;
 
       --  Do not give a warning for a package with no body
 
-      if Ekind (Ent) = E_Generic_Package
-        and then not Has_Generic_Body (N)
-      then
+      if Ekind (Ent) = E_Generic_Package and then not Has_Generic_Body (N) then
          return;
       end if;
 
@@ -738,7 +735,7 @@ package body Sem_Elab is
          --  the sgi build and storage errors. To be resolved later ???
 
          if (Callee_Unit_Internal and Caller_Unit_Internal)
-            and then not Debug_Flag_EE
+           and then not Debug_Flag_EE
          then
             return;
          end if;
@@ -776,7 +773,14 @@ package body Sem_Elab is
          if Unit_Caller /= No_Unit
            and then Unit_Callee /= Unit_Caller
            and then not Dynamic_Elaboration_Checks
+
+            --  This is an attempt to solve the problem of mishandling of
+            --  generic formal parameters, but it does not work right yet ???
+
+            --  and then not Used_As_Generic_Actual (Ent)
          then
+            --  It is here that things go wrong for calling a generic formal???
+
             E_Scope := Spec_Entity (Cunit_Entity (Unit_Caller));
 
             --  If we don't get a spec entity, just ignore call. Not quite
@@ -802,9 +806,7 @@ package body Sem_Elab is
             --  Loop to carefully follow renamings and derivations one step
             --  outside the current unit, but not further.
 
-            if not Inst_Case
-              and then Present (Alias (Ent))
-            then
+            if not Inst_Case and then Present (Alias (Ent)) then
                E_Scope := Alias (Ent);
             else
                E_Scope := Ent;
@@ -1182,7 +1184,7 @@ package body Sem_Elab is
       --  For an entry call, check relevant restriction
 
       if Nkind (N) = N_Entry_Call_Statement
-         and then not In_Subprogram_Or_Concurrent_Unit
+        and then not In_Subprogram_Or_Concurrent_Unit
       then
          Check_Restriction (No_Entry_Calls_In_Elaboration_Code, N);
 
@@ -1339,9 +1341,8 @@ package body Sem_Elab is
                   --  Filter out case of default expressions, where we do not
                   --  do the check at this stage.
 
-                  if Nkind (P) = N_Parameter_Specification
-                       or else
-                     Nkind (P) = N_Component_Declaration
+                  if Nkind_In (P, N_Parameter_Specification,
+                                  N_Component_Declaration)
                   then
                      return;
                   end if;
@@ -1352,13 +1353,10 @@ package body Sem_Elab is
                   if Nkind (P) = N_Protected_Body then
                      return;
 
-                  elsif Nkind (P) = N_Subprogram_Body
-                       or else
-                     Nkind (P) = N_Task_Body
-                       or else
-                     Nkind (P) = N_Block_Statement
-                       or else
-                     Nkind (P) = N_Entry_Body
+                  elsif Nkind_In (P, N_Subprogram_Body,
+                                     N_Task_Body,
+                                     N_Block_Statement,
+                                     N_Entry_Body)
                   then
                      if L = Declarations (P) then
                         exit;
@@ -1499,9 +1497,7 @@ package body Sem_Elab is
       --  treat the current node as a call to each of these functions, to check
       --  their elaboration impact.
 
-      if Is_Init_Proc (Ent)
-        and then From_Elab_Code
-      then
+      if Is_Init_Proc (Ent) and then From_Elab_Code then
          Process_Init_Proc : declare
             Unit_Decl : constant Node_Id := Unit_Declaration_Node (Ent);
 
@@ -1713,7 +1709,7 @@ package body Sem_Elab is
          begin
             if Nkind (Decl) = N_Object_Declaration
               and then (Present (Expression (Decl))
-                          or else No_Initialization (Decl))
+                         or else No_Initialization (Decl))
             then
                return;
             end if;
@@ -1842,9 +1838,7 @@ package body Sem_Elab is
 
       C_Scope := Current_Scope;
 
-      if Present (Outer_Scope)
-        and then Within (Scope (Ent), Outer_Scope)
-      then
+      if Present (Outer_Scope) and then Within (Scope (Ent), Outer_Scope) then
          Set_C_Scope;
          Check_A_Call (N, Ent, Outer_Scope, Inter_Unit_Only => False);
 
@@ -1992,8 +1986,8 @@ package body Sem_Elab is
          --  code, do not trace past an accept statement, because the rendez-
          --  vous will happen after elaboration.
 
-         if (Nkind (Original_Node (N)) = N_Accept_Statement
-              or else Nkind (Original_Node (N)) = N_Selective_Accept)
+         if Nkind_In (Original_Node (N), N_Accept_Statement,
+                                         N_Selective_Accept)
            and then Restriction_Active (No_Entry_Calls_In_Elaboration_Code)
          then
             return Abandon;
@@ -2021,8 +2015,8 @@ package body Sem_Elab is
 
             return OK;
 
-         --  If we have an access attribute for a subprogram, check
-         --  it. Suppress this behavior under debug flag.
+         --  If we have an access attribute for a subprogram, check it.
+         --  Suppress this behavior under debug flag.
 
          elsif not Debug_Flag_Dot_UU
            and then Nkind (N) = N_Attribute_Reference
@@ -2086,10 +2080,7 @@ package body Sem_Elab is
 
       Sbody := Unit_Declaration_Node (E);
 
-      if Nkind (Sbody) /= N_Subprogram_Body
-           and then
-         Nkind (Sbody) /= N_Package_Body
-      then
+      if not Nkind_In (Sbody, N_Subprogram_Body, N_Package_Body) then
          Ebody := Corresponding_Body (Sbody);
 
          if No (Ebody) then
@@ -2406,8 +2397,7 @@ package body Sem_Elab is
                if No (Corresponding_Body (Unit_Declaration_Node (Proc)))
                  and then
                    (not Is_Generic_Instance (Scope (Proc))
-                      or else
-                    Scope (Proc) = Scope (Defining_Identifier (Decl)))
+                     or else Scope (Proc) = Scope (Defining_Identifier (Decl)))
                then
                   Error_Msg_Warn := SPARK_Mode /= On;
                   Error_Msg_N
@@ -2636,9 +2626,8 @@ package body Sem_Elab is
       --  that is, on which we need to place to elaboration flag. This happens
       --  with init proc calls.
 
-      if Is_Init_Proc (Subp)
-        or else Init_Call
-      then
+      if Is_Init_Proc (Subp) or else Init_Call then
+
          --  The initialization call is on an object whose type is not declared
          --  in the same scope as the subprogram. The type of the object must
          --  be a subtype of the type of operation. This object is the first
@@ -2996,9 +2985,7 @@ package body Sem_Elab is
    begin
       --  Check whether Id is a procedure with at least one parameter
 
-      if Ekind (Id) = E_Procedure
-        and then Present (First_Formal (Id))
-      then
+      if Ekind (Id) = E_Procedure and then Present (First_Formal (Id)) then
          declare
             Typ      : constant Entity_Id := Etype (First_Formal (Id));
             Deep_Fin : Entity_Id := Empty;
@@ -3025,10 +3012,8 @@ package body Sem_Elab is
                Fin := Find_Prim_Op (Typ, Name_Finalize);
             end if;
 
-            return
-                (Present (Deep_Fin) and then Id = Deep_Fin)
-              or else
-                (Present (Fin) and then Id = Fin);
+            return    (Present (Deep_Fin) and then Id = Deep_Fin)
+              or else (Present (Fin)      and then Id = Fin);
          end;
       end if;
 
@@ -3100,11 +3085,7 @@ package body Sem_Elab is
       S1 := Scop1;
       while S1 /= Standard_Standard
         and then not Is_Compilation_Unit (S1)
-        and then (Ekind (S1) = E_Package
-                    or else
-                  Ekind (S1) = E_Protected_Type
-                    or else
-                  Ekind (S1) = E_Block)
+        and then Ekind_In (S1, E_Package, E_Protected_Type, E_Block)
       loop
          S1 := Scope (S1);
       end loop;
@@ -3114,11 +3095,7 @@ package body Sem_Elab is
       S2 := Scop2;
       while S2 /= Standard_Standard
         and then not Is_Compilation_Unit (S2)
-        and then (Ekind (S2) = E_Package
-                    or else
-                  Ekind (S2) = E_Protected_Type
-                    or else
-                  Ekind (S2) = E_Block)
+        and then Ekind_In (S2, E_Package, E_Protected_Type, E_Block)
       loop
          S2 := Scope (S2);
       end loop;
@@ -3172,8 +3149,8 @@ package body Sem_Elab is
       if Nkind (N) = N_Subprogram_Declaration then
          declare
             Ent : constant Entity_Id := Defining_Unit_Name (Specification (N));
-         begin
 
+         begin
             --  Internal subprograms will already have a generated body, so
             --  there is no need to provide a stub for them.
 
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 35663b3e436..3c06188b97e 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -5530,7 +5530,7 @@ package body Sem_Eval is
 
          if Raises_Constraint_Error (Expr) then
             Error_Msg_N
-              ("\expression raises exception, cannot be static " &
+              ("!expression raises exception, cannot be static " &
                "(RM 4.9(34))", N);
             return;
          end if;
@@ -5551,7 +5551,7 @@ package body Sem_Eval is
            and then not Is_RTE (Typ, RE_Bignum)
          then
             Error_Msg_N
-              ("\static expression must have scalar or string type " &
+              ("!static expression must have scalar or string type " &
                "(RM 4.9(2))", N);
             return;
          end if;
@@ -5615,17 +5615,17 @@ package body Sem_Eval is
                                           or else
                                         Is_Aggregate (Right_Opnd (CO))))
                   then
-                     Error_Msg_N ("\aggregate (#) is never static", N);
+                     Error_Msg_N ("!aggregate (#) is never static", N);
 
                   elsif No (CV) or else not Is_Static_Expression (CV) then
                      Error_Msg_NE
-                       ("\& is not a static constant (RM 4.9(5))", N, E);
+                       ("!& is not a static constant (RM 4.9(5))", N, E);
                   end if;
                end Entity_Case;
 
             else
                Error_Msg_NE
-                 ("\& is not static constant or named number "
+                 ("!& is not static constant or named number "
                   & "(RM 4.9(5))", N, E);
             end if;
 
@@ -5634,7 +5634,7 @@ package body Sem_Eval is
          when N_Binary_Op | N_Short_Circuit | N_Membership_Test =>
             if Nkind (N) in N_Op_Shift then
                Error_Msg_N
-                ("\shift functions are never static (RM 4.9(6,18))", N);
+                ("!shift functions are never static (RM 4.9(6,18))", N);
 
             else
                Why_Not_Static (Left_Opnd (N));
@@ -5661,7 +5661,7 @@ package body Sem_Eval is
 
             if Attribute_Name (N) = Name_Size then
                Error_Msg_N
-                 ("\size attribute is only static for static scalar type "
+                 ("!size attribute is only static for static scalar type "
                   & "(RM 4.9(7,8))", N);
 
             --  Flag array cases
@@ -5674,7 +5674,7 @@ package body Sem_Eval is
                   Attribute_Name (N) /= Name_Length
                then
                   Error_Msg_N
-                    ("\static array attribute must be Length, First, or Last "
+                    ("!static array attribute must be Length, First, or Last "
                      & "(RM 4.9(8))", N);
 
                --  Since we know the expression is not-static (we already
@@ -5682,7 +5682,7 @@ package body Sem_Eval is
 
                else
                   Error_Msg_N
-                    ("\prefix is non-static array (RM 4.9(8))", Prefix (N));
+                    ("!prefix is non-static array (RM 4.9(8))", Prefix (N));
                end if;
 
                return;
@@ -5695,7 +5695,7 @@ package body Sem_Eval is
                   Is_Generic_Type (E)
             then
                Error_Msg_N
-                 ("\attribute of generic type is never static "
+                 ("!attribute of generic type is never static "
                   & "(RM 4.9(7,8))", N);
 
             elsif Is_Static_Subtype (E) then
@@ -5703,12 +5703,12 @@ package body Sem_Eval is
 
             elsif Is_Scalar_Type (E) then
                Error_Msg_N
-                 ("\prefix type for attribute is not static scalar subtype "
+                 ("!prefix type for attribute is not static scalar subtype "
                   & "(RM 4.9(7))", N);
 
             else
                Error_Msg_N
-                 ("\static attribute must apply to array/scalar type "
+                 ("!static attribute must apply to array/scalar type "
                   & "(RM 4.9(7,8))", N);
             end if;
 
@@ -5716,13 +5716,13 @@ package body Sem_Eval is
 
          when N_String_Literal =>
             Error_Msg_N
-              ("\subtype of string literal is non-static (RM 4.9(4))", N);
+              ("!subtype of string literal is non-static (RM 4.9(4))", N);
 
          --  Explicit dereference
 
          when N_Explicit_Dereference =>
             Error_Msg_N
-              ("\explicit dereference is never static (RM 4.9)", N);
+              ("!explicit dereference is never static (RM 4.9)", N);
 
          --  Function call
 
@@ -5734,7 +5734,7 @@ package body Sem_Eval is
             --  scalar arithmetic operation.
 
             if not Is_RTE (Typ, RE_Bignum) then
-               Error_Msg_N ("\non-static function call (RM 4.9(6,18))", N);
+               Error_Msg_N ("!non-static function call (RM 4.9(6,18))", N);
             end if;
 
          --  Parameter assocation (test actual parameter)
@@ -5745,12 +5745,12 @@ package body Sem_Eval is
          --  Indexed component
 
          when N_Indexed_Component =>
-            Error_Msg_N ("\indexed component is never static (RM 4.9)", N);
+            Error_Msg_N ("!indexed component is never static (RM 4.9)", N);
 
          --  Procedure call
 
          when N_Procedure_Call_Statement =>
-            Error_Msg_N ("\procedure call is never static (RM 4.9)", N);
+            Error_Msg_N ("!procedure call is never static (RM 4.9)", N);
 
          --  Qualified expression (test expression)
 
@@ -5760,7 +5760,7 @@ package body Sem_Eval is
          --  Aggregate
 
          when N_Aggregate | N_Extension_Aggregate =>
-            Error_Msg_N ("\an aggregate is never static (RM 4.9)", N);
+            Error_Msg_N ("!an aggregate is never static (RM 4.9)", N);
 
          --  Range
 
@@ -5781,12 +5781,12 @@ package body Sem_Eval is
          --  Selected component
 
          when N_Selected_Component =>
-            Error_Msg_N ("\selected component is never static (RM 4.9)", N);
+            Error_Msg_N ("!selected component is never static (RM 4.9)", N);
 
          --  Slice
 
          when N_Slice =>
-            Error_Msg_N ("\slice is never static (RM 4.9)", N);
+            Error_Msg_N ("!slice is never static (RM 4.9)", N);
 
          when N_Type_Conversion =>
             Why_Not_Static (Expression (N));
@@ -5795,7 +5795,7 @@ package body Sem_Eval is
               or else not Is_Static_Subtype (Entity (Subtype_Mark (N)))
             then
                Error_Msg_N
-                 ("\static conversion requires static scalar subtype result "
+                 ("!static conversion requires static scalar subtype result "
                   & "(RM 4.9(9))", N);
             end if;
 
@@ -5803,7 +5803,7 @@ package body Sem_Eval is
 
          when N_Unchecked_Type_Conversion =>
             Error_Msg_N
-              ("\unchecked type conversion is never static (RM 4.9)", N);
+              ("!unchecked type conversion is never static (RM 4.9)", N);
 
          --  All other cases, no reason to give
 
diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads
index 8bd8761f0da..7d8779d373a 100644
--- a/gcc/ada/sem_eval.ads
+++ b/gcc/ada/sem_eval.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -470,17 +470,23 @@ package Sem_Eval is
 
    procedure Why_Not_Static (Expr : Node_Id);
    --  This procedure may be called after generating an error message that
-   --  complains that something is non-static. If it finds good reasons,
-   --  it generates one or more continuation error messages pointing the
-   --  appropriate offending component of the expression. If no good reasons
-   --  can be figured out, then no messages are generated. The expectation here
-   --  is that the caller has already issued a message complaining that the
-   --  expression is non-static. Note that this message should be placed using
-   --  Error_Msg_F or Error_Msg_FE, so that it will sort before any messages
-   --  placed by this call. Note that it is fine to call Why_Not_Static with
-   --  something that is not an expression, and usually this has no effect, but
-   --  in some cases (N_Parameter_Association or N_Range), it makes sense for
-   --  the internal recursive calls.
+   --  complains that something is non-static. If it finds good reasons, it
+   --  generates one or more error messages pointing the appropriate offending
+   --  component of the expression. If no good reasons can be figured out, then
+   --  no messages are generated. The expectation here is that the caller has
+   --  already issued a message complaining that the expression is non-static.
+   --  Note that this message should be placed using Error_Msg_F or
+   --  Error_Msg_FE, so that it will sort before any messages placed by this
+   --  call. Note that it is fine to call Why_Not_Static with something that
+   --  is not an expression, and usually this has no effect, but in some cases
+   --  (N_Parameter_Association or N_Range), it makes sense for the internal
+   --  recursive calls.
+   --
+   --  Note that these messages are not continuation messages, instead they are
+   --  separate unconditional messages, marked with '!'. The reason for this is
+   --  that they can be posted at a different location from the maim message as
+   --  documented above ("appropriate offending component"), and continuation
+   --  messages must always point to the same location as the parent message.
 
    procedure Initialize;
    --  Initializes the internal data structures. Must be called before each
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index e73a54e615a..012345ee7ef 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1999-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1999-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -766,6 +766,14 @@ package body Sem_Warn is
       --  For an entry formal entity from an entry declaration, find the
       --  corresponding body formal from the given accept statement.
 
+      function May_Need_Initialized_Actual (Ent : Entity_Id) return Boolean;
+      --  If an entity of a generic type has default initialization, then the
+      --  corresponding actual type should be fully initialized, or else there
+      --  will be uninitialized components in the instantiation, that might go
+      --  unreported. This predicate allows the compiler to emit an appropriate
+      --  warning in the generic itself. In a sense, the use of a type that
+      --  requires full initialization is a weak part of the generic contract.
+
       function Missing_Subunits return Boolean;
       --  We suppress warnings when there are missing subunits, because this
       --  may generate too many false positives: entities in a parent may only
@@ -815,6 +823,44 @@ package body Sem_Warn is
          raise Program_Error;
       end Body_Formal;
 
+      -----------------------------------
+      --   May_Need_Initialized_Actual --
+      -----------------------------------
+
+      function May_Need_Initialized_Actual (Ent : Entity_Id) return Boolean is
+         T   : constant Entity_Id := Etype (Ent);
+         Par : constant Node_Id   := Parent (T);
+         Res : Boolean;
+
+      begin
+         if not Is_Generic_Type (T) then
+            Res := False;
+
+         elsif (Nkind (Par)) = N_Private_Extension_Declaration then
+            Set_Needs_Initialized_Actual (Par);
+            Res := True;
+
+         elsif (Nkind (Par)) = N_Formal_Type_Declaration
+           and then Nkind (Formal_Type_Definition (Par))
+              = N_Formal_Private_Type_Definition
+         then
+            Set_Needs_Initialized_Actual (Formal_Type_Definition (Par));
+            Res := True;
+
+         else
+            Res := False;
+         end if;
+
+         if Res then
+            Error_Msg_N ("?!variable& of a generic type is "
+              & "potentially uninitialized", Ent);
+            Error_Msg_NE ("\?instantiations must provide fully initialized "
+              & "type for&", Ent, T);
+         end if;
+
+         return Res;
+      end May_Need_Initialized_Actual;
+
       ----------------------
       -- Missing_Subunits --
       ----------------------
@@ -1266,6 +1312,7 @@ package body Sem_Warn is
                         if not Has_Unmodified (E1)
                           and then not Warnings_Off_E1
                           and then not Is_Junk_Name (Chars (E1))
+                          and then not May_Need_Initialized_Actual (E1)
                         then
                            Output_Reference_Error
                              ("?v?variable& is read but never assigned!");
@@ -1274,6 +1321,7 @@ package body Sem_Warn is
                      elsif not Has_Unreferenced (E1)
                        and then not Warnings_Off_E1
                        and then not Is_Junk_Name (Chars (E1))
+                       and then not May_Need_Initialized_Actual (E1)
                      then
                         Output_Reference_Error -- CODEFIX
                           ("?v?variable& is never read and never assigned!");
@@ -1403,6 +1451,7 @@ package body Sem_Warn is
                   end if;
 
                   goto Continue;
+
                end if;
             end if;
 
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index dbd54bbdf1e..c1eaae55793 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -2224,6 +2224,15 @@ package body Sinfo is
       return List2 (N);
    end Names;
 
+   function Needs_Initialized_Actual
+     (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Formal_Private_Type_Definition
+        or else NT (N).Nkind = N_Private_Extension_Declaration);
+      return Flag18 (N);
+   end Needs_Initialized_Actual;
+
    function Next_Entity
       (N : Node_Id) return Node_Id is
    begin
@@ -5364,6 +5373,15 @@ package body Sinfo is
       Set_List2_With_Parent (N, Val);
    end Set_Names;
 
+   procedure Set_Needs_Initialized_Actual
+     (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Formal_Private_Type_Definition
+        or else NT (N).Nkind = N_Private_Extension_Declaration);
+      Set_Flag18 (N, Val);
+   end Set_Needs_Initialized_Actual;
+
    procedure Set_Next_Entity
       (N : Node_Id; Val : Node_Id) is
    begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index ec4a3bdab9d..3f3c312f609 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -1701,6 +1701,12 @@ package Sinfo is
    --    present in an N_Subtype_Indication node, since we also use these in
    --    calls to Freeze_Expression.
 
+   --  Needs_Initialized_Actual (Flag18-Sem)
+   --    Present in formal_private_type_definitions and on private extension
+   --    declarations. Set when the use of a formal type in a generic suggests
+   --    that the actual should be a fully initialized type, to avoid potential
+   --    use of uninitialized values.
+
    --  Next_Entity (Node2-Sem)
    --    Present in defining identifiers, defining character literals and
    --    defining operator symbols (i.e. in all entities). The entities of a
@@ -5280,6 +5286,7 @@ package Sinfo is
       --  Synchronized_Present (Flag7)
       --  Subtype_Indication (Node5)
       --  Interface_List (List2) (set to No_List if none)
+      --  Needs_Initialized_Actual (Flag18-Sem)
 
       ---------------------
       -- 8.4  Use Clause --
@@ -6705,6 +6712,7 @@ package Sinfo is
       --  Abstract_Present (Flag4)
       --  Tagged_Present (Flag15)
       --  Limited_Present (Flag17)
+      --  Needs_Initialized_Actual (Flag18-Sem)
 
       --------------------------------------------
       -- 12.5.1  Formal Derived Type Definition --
@@ -8930,7 +8938,6 @@ package Sinfo is
 
    function Generalized_Indexing
      (N : Node_Id) return Node_Id;    -- Node4
-
    function Generic_Associations
      (N : Node_Id) return List_Id;    -- List3
 
@@ -9195,6 +9202,9 @@ package Sinfo is
    function Names
      (N : Node_Id) return List_Id;    -- List2
 
+   function Needs_Initialized_Actual
+     (N : Node_Id) return Boolean;    -- Flag18
+
    function Next_Entity
      (N : Node_Id) return Node_Id;    -- Node2
 
@@ -10194,6 +10204,9 @@ package Sinfo is
    procedure Set_Names
      (N : Node_Id; Val : List_Id);            -- List2
 
+   procedure Set_Needs_Initialized_Actual
+     (N : Node_Id; Val : Boolean := True);    -- Flag18
+
    procedure Set_Next_Entity
      (N : Node_Id; Val : Node_Id);            -- Node2
 
@@ -10940,7 +10953,7 @@ package Sinfo is
        (1 => True,    --  Expressions (List1)
         2 => False,   --  unused
         3 => True,    --  Prefix (Node3)
-        4 => False,   --  Generalized_Indexing (Node4-Sem)
+        4 => False,    --  Generalized_Indexing (Node4-Sem)
         5 => False),  --  Etype (Node5-Sem)
 
      N_Slice =>
@@ -12483,6 +12496,7 @@ package Sinfo is
    pragma Inline (Must_Override);
    pragma Inline (Name);
    pragma Inline (Names);
+   pragma Inline (Needs_Initialized_Actual);
    pragma Inline (Next_Entity);
    pragma Inline (Next_Exit_Statement);
    pragma Inline (Next_Implicit_With);
@@ -12812,6 +12826,7 @@ package Sinfo is
    pragma Inline (Set_Must_Override);
    pragma Inline (Set_Name);
    pragma Inline (Set_Names);
+   pragma Inline (Set_Needs_Initialized_Actual);
    pragma Inline (Set_Next_Entity);
    pragma Inline (Set_Next_Exit_Statement);
    pragma Inline (Set_Next_Implicit_With);