[multiple changes]

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.

From-SVN: r210705

gcc/ada/ChangeLog

 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>

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;

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 --

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 :=

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);

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

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);

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
 

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

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;
 

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

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);