2007-12-06 Robert Dewar <dewar@adacore.com>

	* sem_ch5.adb, s-taskin.adb, a-ciorma.adb, a-coorma.adb, a-cohama.adb, 
	a-cihama.adb, g-awk.adb, 
	s-inmaop-posix.adb: Update handling of assigned value/unreferenced
	warnings

	* exp_smem.adb: Update handling of assigned value/unreferenced warnings

	* sem.adb: Update handling of assigned value/unreferenced warnings

	* a-exexpr-gcc.adb: Add a pragma warnings off for boolean return

	* lib-xref.ads: Improve documentation for k xref type

	* lib-xref.adb: 
	Update handling of assigned value/unreferenced warnings
	(Generate_Reference): Warning for reference to entity for which a
	pragma Unreferenced has been given should be unconditional.
	If the entity is a discriminal, mark the original
	discriminant as referenced.

	* sem_warn.ads, sem_warn.adb
	(Check_One_Unit): Test Renamed_In_Spec to control giving warning for
	no entities referenced in package
	(Check_One_Unit): Don't give message about no entities referenced in
	a package if a pragma Unreferenced has appeared.
	Handle new warning flag -gnatw.a/-gnatw.A
	Update handling of assigned value/unreferenced warnings

	* atree.h: Add flags up to Flag247
	(Flag231): New macro.



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

16 files changed, 336 insertions, 152 deletions

diff --git a/gcc/ada/a-cihama.adb b/gcc/ada/a-cihama.adb
index 45dfe984d51..0eb49b19d03 100644
--- a/gcc/ada/a-cihama.adb
+++ b/gcc/ada/a-cihama.adb
@@ -967,9 +967,7 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
 
          declare
             K : Key_Type renames Position.Node.Key.all;
-
             E : Element_Type renames Position.Node.Element.all;
-            pragma Unreferenced (E);
 
          begin
             Process (K, E);
diff --git a/gcc/ada/a-ciorma.adb b/gcc/ada/a-ciorma.adb
index 4372ad404f0..7eb57d1434a 100644
--- a/gcc/ada/a-ciorma.adb
+++ b/gcc/ada/a-ciorma.adb
@@ -1302,9 +1302,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
 
          declare
             K : Key_Type renames Position.Node.Key.all;
-
             E : Element_Type renames Position.Node.Element.all;
-            pragma Unreferenced (E);
 
          begin
             Process (K, E);
diff --git a/gcc/ada/a-cohama.adb b/gcc/ada/a-cohama.adb
index d8f7ff95d77..8d14442f8d1 100644
--- a/gcc/ada/a-cohama.adb
+++ b/gcc/ada/a-cohama.adb
@@ -852,9 +852,10 @@ package body Ada.Containers.Hashed_Maps is
          declare
             K : Key_Type renames Position.Node.Key;
             E : Element_Type renames Position.Node.Element;
-            pragma Unreferenced (E);
+
          begin
             Process (K, E);
+
          exception
             when others =>
                L := L - 1;
diff --git a/gcc/ada/a-coorma.adb b/gcc/ada/a-coorma.adb
index 01074d58512..7924fcd7ebe 100644
--- a/gcc/ada/a-coorma.adb
+++ b/gcc/ada/a-coorma.adb
@@ -1183,9 +1183,7 @@ package body Ada.Containers.Ordered_Maps is
 
          declare
             K : Key_Type renames Position.Node.Key;
-
             E : Element_Type renames Position.Node.Element;
-            pragma Unreferenced (E);
 
          begin
             Process (K, E);
diff --git a/gcc/ada/a-exexpr-gcc.adb b/gcc/ada/a-exexpr-gcc.adb
index 4b6f904c2e7..c27c31a2114 100644
--- a/gcc/ada/a-exexpr-gcc.adb
+++ b/gcc/ada/a-exexpr-gcc.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, 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- --
@@ -242,18 +242,19 @@ package body Exception_Propagation is
    --  Copy all the components of Source to Target as well as the
    --  Private_Data pointer.
 
-   ------------------------------------------------------------
-   -- Accessors to basic components of a GNAT exception data --
-   ------------------------------------------------------------
+   --------------------------------------------------------------------
+   -- Accessors to Basic Components of a GNAT Exception Data Pointer --
+   --------------------------------------------------------------------
 
-   --  As of today, these are only used by the C implementation of the
-   --  GCC propagation personality routine to avoid having to rely on a C
+   --  As of today, these are only used by the C implementation of the GCC
+   --  propagation personality routine to avoid having to rely on a C
    --  counterpart of the whole exception_data structure, which is both
-   --  painful and error prone. These subprograms could be moved to a
-   --  more widely visible location if need be.
+   --  painful and error prone. These subprograms could be moved to a more
+   --  widely visible location if need be.
 
    function Is_Handled_By_Others (E : Exception_Data_Ptr) return Boolean;
    pragma Export (C, Is_Handled_By_Others, "__gnat_is_handled_by_others");
+   pragma Warnings (Off, Is_Handled_By_Others);
 
    function Language_For (E : Exception_Data_Ptr) return Character;
    pragma Export (C, Language_For, "__gnat_language_for");
diff --git a/gcc/ada/atree.h b/gcc/ada/atree.h
index 09ed452bedc..9dda243499c 100644
--- a/gcc/ada/atree.h
+++ b/gcc/ada/atree.h
@@ -726,6 +726,7 @@ extern Node_Id Current_Error_Node;
 #define Flag213(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag213)
 #define Flag214(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag214)
 #define Flag215(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag215)
+
 #define Flag216(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag216)
 #define Flag217(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag217)
 #define Flag218(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag218)
@@ -741,3 +742,20 @@ extern Node_Id Current_Error_Node;
 #define Flag228(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag228)
 #define Flag229(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag229)
 #define Flag230(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag230)
+#define Flag231(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag231)
+#define Flag232(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag232)
+#define Flag233(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag233)
+#define Flag234(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag234)
+#define Flag235(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag235)
+#define Flag236(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag236)
+#define Flag237(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag237)
+#define Flag238(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag238)
+#define Flag239(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag239)
+#define Flag240(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag240)
+#define Flag241(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag241)
+#define Flag242(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag242)
+#define Flag243(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag243)
+#define Flag244(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag244)
+#define Flag245(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag245)
+#define Flag246(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag246)
+#define Flag247(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag247)
diff --git a/gcc/ada/exp_smem.adb b/gcc/ada/exp_smem.adb
index b34a1ef80dc..e5889bfb9ef 100644
--- a/gcc/ada/exp_smem.adb
+++ b/gcc/ada/exp_smem.adb
@@ -245,17 +245,25 @@ package body Exp_Smem is
    -------------------
 
    function Is_Out_Actual (N : Node_Id) return Boolean is
-      Kind : Entity_Kind;
-      Call : Node_Id;
+      Formal : Entity_Id;
+      Call   : Node_Id;
 
    begin
-      Find_Actual_Mode (N, Kind, Call);
+      Find_Actual (N, Formal, Call);
 
-      if Kind = E_Out_Parameter or else Kind = E_In_Out_Parameter then
-         Insert_Node := Call;
-         return True;
-      else
+      if No (Formal) then
          return False;
+
+      else
+         if Ekind (Formal) = E_Out_Parameter
+              or else
+            Ekind (Formal) = E_In_Out_Parameter
+         then
+            Insert_Node := Call;
+            return True;
+         else
+            return False;
+         end if;
       end if;
    end Is_Out_Actual;
 
diff --git a/gcc/ada/g-awk.adb b/gcc/ada/g-awk.adb
index 60a85b51c5d..4239bb38990 100644
--- a/gcc/ada/g-awk.adb
+++ b/gcc/ada/g-awk.adb
@@ -1475,7 +1475,6 @@ package body GNAT.AWK is
 
    procedure Split_Line (Session : Session_Type) is
       Fields : Field_Table.Instance renames Session.Data.Fields;
-      pragma Unreferenced (Fields);
    begin
       Field_Table.Init (Fields);
       Split.Current_Line (Session.Data.Separators.all, Session);
diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index b0a96af5c26..931049335e8 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -167,8 +167,8 @@ package body Lib.Xref is
       if Sloc (Entity (N)) /= Standard_Location then
          Generate_Reference (Entity (N), N);
 
-         --  A reference to an implicit inequality operator is a also a
-         --  reference to the user-defined equality.
+         --  A reference to an implicit inequality operator is also a reference
+         --  to the user-defined equality.
 
          if Nkind (N) = N_Op_Ne
            and then not Comes_From_Source (Entity (N))
@@ -200,11 +200,11 @@ package body Lib.Xref is
    ------------------------
 
    procedure Generate_Reference
-     (E             : Entity_Id;
-      N             : Node_Id;
-      Typ           : Character := 'r';
-      Set_Ref       : Boolean   := True;
-      Force         : Boolean   := False)
+     (E       : Entity_Id;
+      N       : Node_Id;
+      Typ     : Character := 'r';
+      Set_Ref : Boolean   := True;
+      Force   : Boolean   := False)
    is
       Indx : Nat;
       Nod  : Node_Id;
@@ -212,9 +212,12 @@ package body Lib.Xref is
       Def  : Source_Ptr;
       Ent  : Entity_Id;
 
+      Call   : Node_Id;
+      Formal : Entity_Id;
+      --  Used for call to Find_Actual
+
       Kind : Entity_Kind;
-      Call : Node_Id;
-      --  Arguments used in call to Find_Actual_Mode
+      --  If Formal is non-Empty, then its Ekind, otherwise E_Void
 
       function Is_On_LHS (Node : Node_Id) return Boolean;
       --  Used to check if a node is on the left hand side of an assignment.
@@ -256,7 +259,7 @@ package body Lib.Xref is
             return False;
          end if;
 
-         --  Immediat return if appeared as OUT parameter
+         --  Immediate return if appeared as OUT parameter
 
          if Kind = E_Out_Parameter then
             return True;
@@ -311,7 +314,13 @@ package body Lib.Xref is
 
    begin
       pragma Assert (Nkind (E) in N_Entity);
-      Find_Actual_Mode (N, Kind, Call);
+      Find_Actual (N, Formal, Call);
+
+      if Present (Formal) then
+         Kind := Ekind (Formal);
+      else
+         Kind := E_Void;
+      end if;
 
       --  Check for obsolescent reference to package ASCII. GNAT treats this
       --  element of annex J specially since in practice, programs make a lot
@@ -407,25 +416,45 @@ package body Lib.Xref is
 
       if Set_Ref then
 
-         --  For a variable that appears on the left side of an assignment
-         --  statement, we set the Referenced_As_LHS flag since this is indeed
-         --  a left hand side. We also set the Referenced_As_LHS flag of a
-         --  prefix of selected or indexed component.
+         --  Assignable object appearing on left side of assignment or as
+         --  an out parameter.
 
-         if (Ekind (E) = E_Variable or else Is_Formal (E))
+         if Is_Assignable (E)
            and then Is_On_LHS (N)
+           and then Ekind (E) /= E_In_Out_Parameter
          then
-            --  If we have the OUT parameter case and the warning mode for
-            --  OUT parameters is not set, treat this as an ordinary reference
-            --  since we don't want warnings about it being unset.
+            --  For objects that are renamings, just set as simply referenced
+            --  we do not try to do assignment type tracking in this case.
 
-            if Kind = E_Out_Parameter and not Warn_On_Out_Parameter_Unread then
+            if Present (Renamed_Object (E)) then
                Set_Referenced (E);
 
-            --  For other cases, set referenced on LHS
+            --  Out parameter case
+
+            elsif Kind = E_Out_Parameter then
+
+               --  If warning mode for all out parameters is set, or this is
+               --  the only warning parameter, then we want to mark this for
+               --  later warning logic by setting Referenced_As_Out_Parameter
+
+               if Warn_On_Modified_As_Out_Parameter (Formal) then
+                  Set_Referenced_As_Out_Parameter (E, True);
+                  Set_Referenced_As_LHS (E, False);
+
+               --  For OUT parameter not covered by the above cases, we simply
+               --  regard it as a normal reference (in this case we do not
+               --  want any of the warning machinery for out parameters).
+
+               else
+                  Set_Referenced (E);
+               end if;
+
+            --  For the left hand of an assignment case, we do nothing here.
+            --  The processing for Analyze_Assignment_Statement will set the
+            --  Referenced_As_LHS flag.
 
             else
-               Set_Referenced_As_LHS (E);
+               null;
             end if;
 
          --  Check for a reference in a pragma that should not count as a
@@ -469,33 +498,33 @@ package body Lib.Xref is
          --  All other cases
 
          else
-            --  Special processing for IN OUT and OUT parameters, where we
-            --  have an implicit assignment to a simple variable.
+            --  Special processing for IN OUT parameters, where we have an
+            --  implicit assignment to a simple variable.
 
-            if (Kind = E_Out_Parameter or else Kind = E_In_Out_Parameter)
-              and then Is_Entity_Name (N)
-              and then Present (Entity (N))
-              and then Is_Assignable (Entity (N))
+            if Kind = E_In_Out_Parameter
+              and then Is_Assignable (E)
             then
-               --  Record implicit assignment unless we have an intrinsic
-               --  subprogram, which is most likely an instantiation of
-               --  Unchecked_Deallocation which we do not want to consider
-               --  as an assignment since it generates false positives. We
-               --  also exclude the case of an IN OUT parameter to a procedure
-               --  called Free, since we suspect similar semantics.
-
-               if Is_Entity_Name (Name (Call))
+               --  For sure this counts as a normal read reference
+
+               Set_Referenced (E);
+               Set_Last_Assignment (E, Empty);
+
+               --  We count it as being referenced as an out parameter if the
+               --  option is set to warn on all out parameters, except that we
+               --  have a special exclusion for an intrinsic subprogram, which
+               --  is most likely an instantiation of Unchecked_Deallocation
+               --  which we do not want to consider as an assignment since it
+               --  generates false positives. We also exclude the case of an
+               --  IN OUT parameter if the name of the procedure is Free,
+               --  since we suspect similar semantics.
+
+               if Warn_On_All_Unread_Out_Parameters
+                 and then Is_Entity_Name (Name (Call))
                  and then not Is_Intrinsic_Subprogram (Entity (Name (Call)))
-                 and then (Kind /= E_In_Out_Parameter
-                             or else Chars (Name (Call)) /= Name_Free)
+                 and then Chars (Name (Call)) /= Name_Free
                then
-                  Set_Referenced_As_LHS (E);
-               end if;
-
-               --  For IN OUT case, treat as also being normal reference
-
-               if Kind = E_In_Out_Parameter then
-                  Set_Referenced (E);
+                  Set_Referenced_As_Out_Parameter (E, True);
+                  Set_Referenced_As_LHS (E, False);
                end if;
 
                --  Any other occurrence counts as referencing the entity
@@ -549,7 +578,7 @@ package body Lib.Xref is
                   while Present (BE) loop
                      if Chars (BE) = Chars (E) then
                         Error_Msg_NE
-                          ("?pragma Unreferenced given for&", N, BE);
+                          ("?pragma Unreferenced given for&!", N, BE);
                         exit;
                      end if;
 
@@ -560,7 +589,7 @@ package body Lib.Xref is
             --  Here we issue the warning, since this is a real reference
 
             else
-               Error_Msg_NE ("?pragma Unreferenced given for&", N, E);
+               Error_Msg_NE ("?pragma Unreferenced given for&!", N, E);
             end if;
          end if;
 
@@ -664,6 +693,15 @@ package body Lib.Xref is
          then
             Ent := Original_Record_Component (E);
 
+         --  If this is an expanded reference to a discriminant, recover the
+         --  original discriminant, which gets the reference.
+
+         elsif Ekind (E) = E_In_Parameter
+           and then  Present (Discriminal_Link (E))
+         then
+            Ent := Discriminal_Link (E);
+            Set_Referenced (Ent);
+
          --  Ignore reference to any other entity that is not from source
 
          else
@@ -1424,11 +1462,13 @@ package body Lib.Xref is
                           (Int (Get_Logical_Line_Number (Sloc (Tref))));
 
                         declare
-                           Ent  : Entity_Id := Tref;
-                           Kind : constant Entity_Kind := Ekind (Ent);
-                           Ctyp : Character := Xref_Entity_Letters (Kind);
+                           Ent  : Entity_Id;
+                           Ctyp : Character;
 
                         begin
+                           Ent := Tref;
+                           Ctyp := Xref_Entity_Letters (Ekind (Ent));
+
                            if Ctyp = '+'
                              and then Present (Full_View (Ent))
                            then
diff --git a/gcc/ada/lib-xref.ads b/gcc/ada/lib-xref.ads
index 1a96e81e6a4..4d23773839e 100644
--- a/gcc/ada/lib-xref.ads
+++ b/gcc/ada/lib-xref.ads
@@ -237,8 +237,33 @@ package Lib.Xref is
    --           source node that generates the implicit reference, and it is
    --           useful to record this one.
 
-   --           k is used to denote a reference to the parent unit, in the
-   --           cross-reference line for a child unit.
+   --           k is another non-standard reference type, used to record a
+   --           reference from a child unit to its parent. For various cross-
+   --           referencing tools, we need a pointer from the xref entries for
+   --           the child to the parent. This is the opposite way round from
+   --           normal xref entries, since the reference is *from* the child
+   --           unit *to* the parent unit, yet appears in the xref entries for
+   --           the child. Consider this example:
+   --
+   --             package q is
+   --             end;
+   --             package q.r is
+   --             end q.r;
+   --
+   --           The ali file for q-r.ads has these entries
+   --
+   --             D q.ads
+   --             D q-r.ads
+   --             D system.ads
+   --             X 1 q.ads
+   --             1K9*q 2e4 2|1r9 2r5
+   --             X 2 q-r.ads
+   --             1K11*r 1|1k9 2|2l7 2e8
+   --
+   --           Here the 2|1r9 entry appearing in the section for the parent
+   --           is the normal reference from the child to the parent. The 1k9
+   --           entry in the section for the child duplicates this information
+   --           but appears in the child rather than the parent.
 
    --           l is used to identify the occurrence in the source of the
    --           name on an end line. This is just a syntactic reference
@@ -568,11 +593,11 @@ package Lib.Xref is
    --  a renaming of a predefined operator.
 
    procedure Generate_Reference
-     (E             : Entity_Id;
-      N             : Node_Id;
-      Typ           : Character := 'r';
-      Set_Ref       : Boolean   := True;
-      Force         : Boolean   := False);
+     (E       : Entity_Id;
+      N       : Node_Id;
+      Typ     : Character := 'r';
+      Set_Ref : Boolean   := True;
+      Force   : Boolean   := False);
    --  This procedure is called to record a reference. N is the location
    --  of the reference and E is the referenced entity. Typ is one of:
    --
diff --git a/gcc/ada/s-inmaop-posix.adb b/gcc/ada/s-inmaop-posix.adb
index a38d391fdfc..2251c23d3c5 100644
--- a/gcc/ada/s-inmaop-posix.adb
+++ b/gcc/ada/s-inmaop-posix.adb
@@ -60,8 +60,9 @@ package body System.Interrupt_Management.Operations is
    Initial_Action : array (Signal) of aliased struct_sigaction;
 
    Default_Action : aliased struct_sigaction;
+   pragma Warnings (Off, Default_Action);
 
-   Ignore_Action  : aliased struct_sigaction;
+   Ignore_Action : aliased struct_sigaction;
 
    ----------------------------
    -- Thread_Block_Interrupt --
@@ -136,11 +137,11 @@ package body System.Interrupt_Management.Operations is
    --------------------
 
    function Interrupt_Wait
-     (Mask : access Interrupt_Mask)
-      return Interrupt_ID
+     (Mask : access Interrupt_Mask) return Interrupt_ID
    is
       Result : Interfaces.C.int;
       Sig    : aliased Signal;
+
    begin
       Result := sigwait (Mask, Sig'Access);
 
diff --git a/gcc/ada/s-taskin.adb b/gcc/ada/s-taskin.adb
index 214d7a45c17..3a4cbe55945 100644
--- a/gcc/ada/s-taskin.adb
+++ b/gcc/ada/s-taskin.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, 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- --
@@ -160,9 +160,11 @@ package body System.Tasking is
 
    procedure Initialize is
       T             : Task_Id;
-      Success       : Boolean;
       Base_Priority : Any_Priority;
 
+      Success : Boolean;
+      pragma Warnings (Off, Success);
+
    begin
       if Initialized then
          return;
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index 7dab13496c1..7fcf2dd2ac7 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -727,6 +727,7 @@ package body Sem is
       To   : Entity_Id)
    is
       Found : Boolean;
+      pragma Warnings (Off, Found);
 
       procedure Search_Stack
         (Top   : Suppress_Stack_Entry_Ptr;
@@ -1282,10 +1283,10 @@ package body Sem is
       S_Sem_Unit         : constant Unit_Number_Type := Current_Sem_Unit;
       S_GNAT_Mode        : constant Boolean          := GNAT_Mode;
       S_Discard_Names    : constant Boolean          := Global_Discard_Names;
-      Generic_Main       : constant Boolean :=
-                             Nkind (Unit (Cunit (Main_Unit)))
-                               in N_Generic_Declaration;
 
+      Generic_Main : constant Boolean :=
+                       Nkind (Unit (Cunit (Main_Unit)))
+                         in N_Generic_Declaration;
       --  If the main unit is generic, every compiled unit, including its
       --  context, is compiled with expansion disabled.
 
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 553f20040cb..3f39aca1307 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -220,9 +220,7 @@ package body Sem_Ch5 is
          --  If assignment operand is a component reference, then we get the
          --  actual subtype of the component for the unconstrained case.
 
-         elsif
-           (Nkind (Opnd) = N_Selected_Component
-             or else Nkind (Opnd) = N_Explicit_Dereference)
+         elsif Nkind_In (Opnd, N_Selected_Component, N_Explicit_Dereference)
            and then not Is_Unchecked_Union (Opnd_Type)
          then
             Decl := Build_Actual_Subtype_Of_Component (Opnd_Type, Opnd);
@@ -685,6 +683,17 @@ package body Sem_Ch5 is
          Check_Elab_Assign (Lhs);
       end if;
 
+      --  Set Referenced_As_LHS if appropriate. We only set this flag if the
+      --  assignment is a source assignment in the extended main source unit.
+      --  We are not interested in any reference information outside this
+      --  context, or in compiler generated assignment statements.
+
+      if Comes_From_Source (N)
+        and then In_Extended_Main_Source_Unit (Lhs)
+      then
+         Set_Referenced_Modified (Lhs, Out_Param => False);
+      end if;
+
       --  Final step. If left side is an entity, then we may be able to
       --  reset the current tracked values to new safe values. We only have
       --  something to do if the left side is an entity name, and expansion
@@ -715,7 +724,7 @@ package body Sem_Ch5 is
                  and then Comes_From_Source (N)
                  and then In_Extended_Main_Source_Unit (Ent)
                then
-                  Warn_On_Useless_Assignment (Ent, Sloc (N));
+                  Warn_On_Useless_Assignment (Ent, N);
                   Set_Last_Assignment (Ent, Lhs);
                end if;
 
@@ -1458,8 +1467,8 @@ package body Sem_Ch5 is
             if Analyzed (Original_Bound) then
                return Original_Bound;
 
-            elsif Nkind (Analyzed_Bound) = N_Integer_Literal
-              or else Nkind (Analyzed_Bound) = N_Character_Literal
+            elsif Nkind_In (Analyzed_Bound, N_Integer_Literal,
+                                            N_Character_Literal)
               or else Is_Entity_Name (Analyzed_Bound)
             then
                Analyze_And_Resolve (Original_Bound, Typ);
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 65ea957c744..6621d66c324 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -114,6 +114,13 @@ package body Sem_Warn is
    --  formal, the setting of the flag in the corresponding spec is also
    --  checked (and True returned if either flag is True).
 
+   function Referenced_As_Out_Parameter_Check_Spec
+     (E : Entity_Id) return Boolean;
+   --  Tests Referenced_As_Out_Parameter status for entity E. If E is not a
+   --  formal, this is simply the setting of Referenced_As_Out_Parameter. If E
+   --  is a body formal, the setting of the flag in the corresponding spec is
+   --  also checked (and True returned if either flag is True).
+
    procedure Warn_On_Unreferenced_Entity
      (Spec_E : Entity_Id;
       Body_E : Entity_Id := Empty);
@@ -222,7 +229,7 @@ package body Sem_Warn is
             Ref := N;
             Var := Entity (Ref);
 
-            --  Case of condition is a comparison with compile time known value
+         --  Case of condition is a comparison with compile time known value
 
          elsif Nkind (N) in N_Op_Compare then
             if Compile_Time_Known_Value (Right_Opnd (N)) then
@@ -237,12 +244,12 @@ package body Sem_Warn is
                return;
             end if;
 
-            --  If condition is a negation, check its operand
+         --  If condition is a negation, check its operand
 
          elsif Nkind (N) = N_Op_Not then
             Find_Var (Right_Opnd (N));
 
-            --  Case of condition is function call
+         --  Case of condition is function call
 
          elsif Nkind (N) = N_Function_Call then
 
@@ -252,7 +259,7 @@ package body Sem_Warn is
             if not Is_Entity_Name (Name (N)) then
                return;
 
-               --  Forget it if warnings are suppressed on function entity
+            --  Forget it if warnings are suppressed on function entity
 
             elsif Warnings_Off (Entity (Name (N))) then
                return;
@@ -281,14 +288,14 @@ package body Sem_Warn is
                      Find_Var (First (PA));
                   end if;
 
-                  --  Not one argument
+               --  Not one argument
 
                else
                   return;
                end if;
             end;
 
-            --  Any other kind of node is not something we warn for
+         --  Any other kind of node is not something we warn for
 
          else
             return;
@@ -374,7 +381,7 @@ package body Sem_Warn is
             return False;
          end Substring_Present;
 
-         --  Start of processing for Is_Suspicious_Function_Name
+      --  Start of processing for Is_Suspicious_Function_Name
 
       begin
          S := E;
@@ -405,7 +412,7 @@ package body Sem_Warn is
          if N = Iter then
             return Skip;
 
-            --  Direct reference to variable in question
+         --  Direct reference to variable in question
 
          elsif Is_Entity_Name (N)
            and then Present (Entity (N))
@@ -424,6 +431,7 @@ package body Sem_Warn is
 
             declare
                P : Node_Id;
+
             begin
                P := N;
                loop
@@ -999,8 +1007,8 @@ package body Sem_Warn is
                           ("?variable& is never read and never assigned!");
                      end if;
 
-                     --  Deal with special case where this variable is
-                     --  hidden by a loop variable
+                     --  Deal with special case where this variable is hidden
+                     --  by a loop variable.
 
                      if Ekind (E1) = E_Variable
                        and then Present (Hiding_Loop_Variable (E1))
@@ -1115,13 +1123,27 @@ package body Sem_Warn is
 
                --  Check that warnings on unreferenced entities are enabled
 
-              and then ((Check_Unreferenced and then not Is_Formal (E1))
-                           or else
-                        (Check_Unreferenced_Formals and then Is_Formal (E1))
-                           or else
-                        ((Warn_On_Modified_Unread
-                             or Warn_On_Out_Parameter_Unread)
-                           and then Referenced_As_LHS_Check_Spec (E1)))
+              and then
+                ((Check_Unreferenced and then not Is_Formal (E1))
+
+                     --  Case of warning on unreferenced formal
+
+                     or else
+                      (Check_Unreferenced_Formals and then Is_Formal (E1))
+
+                     --  Case of warning on unread variables modified by an
+                     --  assignment, or an out parameter if it is the only one.
+
+                     or else
+                       (Warn_On_Modified_Unread
+                          and then Referenced_As_LHS_Check_Spec (E1))
+
+                     --  Case of warning on any unread out parameter (note
+                     --  such indications are only set if the appropriate
+                     --  warning options were set, so no need to recheck here.
+
+                     or else
+                       Referenced_As_Out_Parameter_Check_Spec (E1))
 
                --  Labels, and enumeration literals, and exceptions. The
                --  warnings are also placed on local packages that cannot be
@@ -1939,10 +1961,13 @@ package body Sem_Warn is
                --  are referenced. If none of the entities are referenced, we
                --  still post a warning. This occurs if the only use of the
                --  package is in a use clause, or in a package renaming
-               --  declaration.
-
-               elsif Ekind (Lunit) = E_Package then
+               --  declaration. This check is skipped for packages that are
+               --  renamed in a spec, since the entities in such a package are
+               --  visible to clients via the renaming.
 
+               elsif Ekind (Lunit) = E_Package
+                 and then not Renamed_In_Spec (Lunit)
+               then
                   --  If Is_Instantiated is set, it means that the package is
                   --  implicitly instantiated (this is the case of parent
                   --  instance or an actual for a generic package formal), and
@@ -1987,9 +2012,13 @@ package body Sem_Warn is
                            --  Else give the warning
 
                            else
-                              Error_Msg_N
-                                ("?no entities of & are referenced!",
-                                 Name (Item));
+                              if not Has_Pragma_Unreferenced
+                                       (Entity (Name (Item)))
+                              then
+                                 Error_Msg_N
+                                   ("?no entities of & are referenced!",
+                                    Name (Item));
+                              end if;
 
                               --  Look for renamings of this package, and flag
                               --  them as well. If the original package has
@@ -2000,11 +2029,12 @@ package body Sem_Warn is
 
                               if Present (Pack)
                                 and then not Warnings_Off (Lunit)
+                                and then not Has_Pragma_Unreferenced (Pack)
                               then
                                  Error_Msg_NE
                                    ("?no entities of & are referenced!",
                                      Unit_Declaration_Node (Pack),
-                                       Pack);
+                                     Pack);
                               end if;
                            end if;
 
@@ -2016,6 +2046,7 @@ package body Sem_Warn is
 
                         elsif Referenced_Check_Spec (Ent)
                           or else Referenced_As_LHS_Check_Spec (Ent)
+                          or else Referenced_As_Out_Parameter_Check_Spec (Ent)
                           or else
                             (From_With_Type (Ent)
                               and then Is_Incomplete_Type (Ent)
@@ -2105,7 +2136,6 @@ package body Sem_Warn is
 
             Next (Item);
          end loop;
-
       end Check_One_Unit;
 
    --  Start of processing for Check_Unused_Withs
@@ -2517,6 +2547,22 @@ package body Sem_Warn is
       end if;
    end Referenced_As_LHS_Check_Spec;
 
+   --------------------------------------------
+   -- Referenced_As_Out_Parameter_Check_Spec --
+   --------------------------------------------
+
+   function Referenced_As_Out_Parameter_Check_Spec
+     (E : Entity_Id) return Boolean
+   is
+   begin
+      if Is_Formal (E) and then Present (Spec_Entity (E)) then
+         return Referenced_As_Out_Parameter (E)
+           or else Referenced_As_Out_Parameter (Spec_Entity (E));
+      else
+         return Referenced_As_Out_Parameter (E);
+      end if;
+   end Referenced_As_Out_Parameter_Check_Spec;
+
    ----------------------------
    -- Set_Dot_Warning_Switch --
    ----------------------------
@@ -2524,6 +2570,12 @@ package body Sem_Warn is
    function Set_Dot_Warning_Switch (C : Character) return Boolean is
    begin
       case C is
+         when 'a' =>
+            Warn_On_Assertion_Failure           := True;
+
+         when 'A' =>
+            Warn_On_Assertion_Failure           := False;
+
          when 'c' =>
             Warn_On_Unrepped_Components         := True;
 
@@ -2531,10 +2583,10 @@ package body Sem_Warn is
             Warn_On_Unrepped_Components         := False;
 
          when 'o' =>
-            Warn_On_Out_Parameter_Unread        := True;
+            Warn_On_All_Unread_Out_Parameters   := True;
 
          when 'O' =>
-            Warn_On_Out_Parameter_Unread        := False;
+            Warn_On_All_Unread_Out_Parameters   := False;
 
          when 'r' =>
             Warn_On_Object_Renames_Function     := True;
@@ -2570,6 +2622,7 @@ package body Sem_Warn is
             Implementation_Unit_Warnings        := True;
             Ineffective_Inline_Warnings         := True;
             Warn_On_Ada_2005_Compatibility      := True;
+            Warn_On_Assertion_Failure           := True;
             Warn_On_Assumed_Low_Bound           := True;
             Warn_On_Bad_Fixed_Value             := True;
             Warn_On_Constant                    := True;
@@ -2594,6 +2647,8 @@ package body Sem_Warn is
             Implementation_Unit_Warnings        := False;
             Ineffective_Inline_Warnings         := False;
             Warn_On_Ada_2005_Compatibility      := False;
+            Warn_On_Assertion_Failure           := False;
+            Warn_On_Assumed_Low_Bound           := False;
             Warn_On_Bad_Fixed_Value             := False;
             Warn_On_Constant                    := False;
             Warn_On_Deleted_Code                := False;
@@ -2604,7 +2659,7 @@ package body Sem_Warn is
             Warn_On_No_Value_Assigned           := False;
             Warn_On_Non_Local_Exception         := False;
             Warn_On_Obsolescent_Feature         := False;
-            Warn_On_Out_Parameter_Unread        := False;
+            Warn_On_All_Unread_Out_Parameters   := False;
             Warn_On_Questionable_Missing_Parens := False;
             Warn_On_Redundant_Constructs        := False;
             Warn_On_Object_Renames_Function     := False;
@@ -2914,6 +2969,17 @@ package body Sem_Warn is
       end if;
    end Warn_On_Known_Condition;
 
+   ---------------------------------------
+   -- Warn_On_Modified_As_Out_Parameter --
+   ---------------------------------------
+
+   function Warn_On_Modified_As_Out_Parameter (E : Entity_Id) return Boolean is
+   begin
+      return
+        (Warn_On_Modified_Unread and then Is_Only_Out_Parameter (E))
+           or else Warn_On_All_Unread_Out_Parameters;
+   end Warn_On_Modified_As_Out_Parameter;
+
    ------------------------------
    -- Warn_On_Suspicious_Index --
    ------------------------------
@@ -3270,22 +3336,17 @@ package body Sem_Warn is
          case Ekind (E) is
             when E_Variable =>
 
-               --  Case of variable that is assigned but not read. We
-               --  suppress the message if the variable is volatile, has an
-               --  address clause, or is imported.
+               --  Case of variable that is assigned but not read. We suppress
+               --  the message if the variable is volatile, has an address
+               --  clause, is aliasied, or is a renaming, or is imported.
 
                if Referenced_As_LHS_Check_Spec (E)
                  and then No (Address_Clause (E))
                  and then not Is_Volatile (E)
                then
-                  if (Warn_On_Modified_Unread or Warn_On_Out_Parameter_Unread)
+                  if Warn_On_Modified_Unread
                     and then not Is_Imported (E)
                     and then not Is_Return_Object (E)
-
-                     --  Suppress message for aliased or renamed variables,
-                     --  since there may be other entities that read the
-                     --  same memory location.
-
                     and then not Is_Aliased (E)
                     and then No (Renamed_Object (E))
 
@@ -3295,9 +3356,12 @@ package body Sem_Warn is
                      Set_Last_Assignment (E, Empty);
                   end if;
 
-               --  Normal case of neither assigned nor read
+               --  Normal case of neither assigned nor read (exclude variables
+               --  referenced as out parameters, since we already generated
+               --  appropriate warnings at the call point in this case).
+
+               elsif not Referenced_As_Out_Parameter (E) then
 
-               else
                   --  We suppress the message for types for which a valid
                   --  pragma Unreferenced_Objects has been given, otherwise
                   --  we go ahead and give the message.
@@ -3396,10 +3460,10 @@ package body Sem_Warn is
 
    procedure Warn_On_Useless_Assignment
      (Ent : Entity_Id;
-      Loc : Source_Ptr := No_Location)
+      N   : Node_Id := Empty)
    is
-      P : Node_Id;
-      X : Node_Id;
+      P    : Node_Id;
+      X    : Node_Id;
 
       function Check_Ref (N : Node_Id) return Traverse_Result;
       --  Used to instantiate Traverse_Func. Returns Abandon if
@@ -3430,9 +3494,11 @@ package body Sem_Warn is
    --  Start of processing for Warn_On_Useless_Assignment
 
    begin
-      --  Check if this is a case we want to warn on, a variable with the
-      --  last assignment field set, with warnings enabled, and which is
-      --  not imported or exported.
+      --  Check if this is a case we want to warn on, a scalar or access
+      --  variable with the last assignment field set, with warnings enabled,
+      --  and which is not imported or exported. We also check that it is OK
+      --  to capture the value. We are not going to capture any value, but
+      --  the warning messages depends on the same kind of conditions.
 
       if Is_Assignable (Ent)
         and then not Is_Return_Object (Ent)
@@ -3441,6 +3507,7 @@ package body Sem_Warn is
         and then not Has_Pragma_Unreferenced_Check_Spec (Ent)
         and then not Is_Imported (Ent)
         and then not Is_Exported (Ent)
+        and then Safe_To_Capture_Value (N, Ent)
       then
          --  Before we issue the message, check covering exception handlers.
          --  Search up tree for enclosing statement sequences and handlers
@@ -3462,24 +3529,37 @@ package body Sem_Warn is
             then
                --  Case of assigned value never referenced
 
-               if Loc = No_Location then
+               if No (N) then
 
                   --  Don't give this for OUT and IN OUT formals, since
                   --  clearly caller may reference the assigned value.
 
                   if Ekind (Ent) = E_Variable then
-                     Error_Msg_NE
-                       ("?useless assignment to&, value never referenced!",
-                        Last_Assignment (Ent), Ent);
+                     if Referenced_As_Out_Parameter (Ent) then
+                        Error_Msg_NE
+                          ("?& modified by call, but value never referenced",
+                           Last_Assignment (Ent), Ent);
+                     else
+                        Error_Msg_NE
+                          ("?useless assignment to&, value never referenced!",
+                           Last_Assignment (Ent), Ent);
+                     end if;
                   end if;
 
                --  Case of assigned value overwritten
 
                else
-                  Error_Msg_Sloc := Loc;
-                  Error_Msg_NE
-                    ("?useless assignment to&, value overwritten #!",
-                     Last_Assignment (Ent), Ent);
+                  Error_Msg_Sloc := Sloc (N);
+
+                  if Referenced_As_Out_Parameter (Ent) then
+                     Error_Msg_NE
+                       ("?& modified by call, but value overwritten #!",
+                        Last_Assignment (Ent), Ent);
+                  else
+                     Error_Msg_NE
+                       ("?useless assignment to&, value overwritten #!",
+                        Last_Assignment (Ent), Ent);
+                  end if;
                end if;
 
                --  Clear last assignment indication and we are done
diff --git a/gcc/ada/sem_warn.ads b/gcc/ada/sem_warn.ads
index 23618d105c2..ae93f5ada6a 100644
--- a/gcc/ada/sem_warn.ads
+++ b/gcc/ada/sem_warn.ads
@@ -157,6 +157,11 @@ package Sem_Warn is
    --  If all these conditions are met, the warning is issued noting that
    --  the result of the test is always false or always true as appropriate.
 
+   function Warn_On_Modified_As_Out_Parameter (E : Entity_Id) return Boolean;
+   --  Returns True if we should activate warnings for entity E being modified
+   --  as an out parameter. True if either Warn_On_Modified_Unread is set for
+   --  an only OUT parameter, or if Warn_On_All_Unread_Out_Parameters is set.
+
    procedure Warn_On_Suspicious_Index (Name : Entity_Id; X : Node_Id);
    --  This is called after resolving an indexed component or a slice. Name
    --  is the entity for the name of the indexed array, and X is the subscript
@@ -176,14 +181,14 @@ package Sem_Warn is
 
    procedure Warn_On_Useless_Assignment
      (Ent : Entity_Id;
-      Loc : Source_Ptr := No_Location);
+      N   : Node_Id := Empty);
    --  Called to check if we have a case of a useless assignment to the given
    --  entity Ent, as indicated by a non-empty Last_Assignment field. This call
    --  should only be made if at least one of the flags Warn_On_Modified_Unread
-   --  or Warn_On_Out_Parameter_Unread is True, and if Ent is in the extended
-   --  main source unit. Loc is No_Location for the end of block call (warning
-   --  message says value unreferenced), or the it is the location of an
-   --  overwriting assignment (warning message points to this assignment).
+   --  or Warn_On_All_Unread_Out_Parameters is True, and if Ent is in the
+   --  extended main source unit. N is Empty for the end of block call
+   --  (warning message says value unreferenced), or the it is the node for
+   --  an overwriting assignment (warning message points to this assignment).
 
    procedure Warn_On_Useless_Assignments (E : Entity_Id);
    pragma Inline (Warn_On_Useless_Assignments);