[multiple changes]

2010-06-14  Robert Dewar  <dewar@adacore.com>

	* opt.ads (Check_Policy_List): Add some clarifying comments
	* sem_prag.adb (Analyze_Pragma, case Check): Set Pragma_Enabled flag
	on rewritten Assert pragma.

2010-06-14  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch6.adb (Check_Overriding_Indicator): Add a special check for
	controlled operations, so that they will be treated as overriding even
	if the overridden subprogram is marked Is_Hidden, as long as the
	overridden subprogram's parent subprogram is not hidden.

2010-06-14  Robert Dewar  <dewar@adacore.com>

	* debug.adb: Entry for gnatw.d no longer specific for while loops
	* einfo.adb (First_Exit_Statement): New attribute for E_Loop
	* einfo.ads (First_Exit_Statement): New attribute for E_Loop
	* sem_ch5.adb (Analyze_Loop_Statement): Check_Infinite_Loop_Warning has
	new calling sequence to include test for EXIT WHEN.
	(Analyze_Exit_Statement): Chain EXIT statement into exit statement chain
	* sem_warn.ads, sem_warn.adb (Check_Infinite_Loop_Warning): Now handles
	EXIT WHEN case.
	* sinfo.adb (Next_Exit_Statement): New attribute of N_Exit_Statement
	node.
	* sinfo.ads (N_Pragma): Correct comment on Sloc field (points to
	PRAGMA, not to pragma identifier).
	(Next_Exit_Statement): New attribute of N_Exit_Statement node

2010-06-14  Robert Dewar  <dewar@adacore.com>

	* sem_res.adb (Resolve_Short_Circuit): Fix sloc of "assertion/check
	would fail" msg.

2010-06-14  Robert Dewar  <dewar@adacore.com>

	* par-ch2.adb (Scan_Pragma_Argument_Association): Clarify message for
	missing pragma argument identifier.

2010-06-14  Robert Dewar  <dewar@adacore.com>

	* atree.ads, atree.adb (Ekind_In): New functions

2010-06-14  Robert Dewar  <dewar@adacore.com>

	* exp_ch4.adb (Expand_N_Op_Expon): Optimize 2**N in stand alone context

2010-06-14  Robert Dewar  <dewar@adacore.com>

	* usage.adb (Usage): Redo documentation of -gnatwa.

From-SVN: r160743

18 files changed, 507 insertions, 92 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 19b0aa2..78ebd92 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,54 @@
+2010-06-14  Robert Dewar  <dewar@adacore.com>
+
+	* opt.ads (Check_Policy_List): Add some clarifying comments
+	* sem_prag.adb (Analyze_Pragma, case Check): Set Pragma_Enabled flag
+	on rewritten Assert pragma.
+
+2010-06-14  Gary Dismukes  <dismukes@adacore.com>
+
+	* sem_ch6.adb (Check_Overriding_Indicator): Add a special check for
+	controlled operations, so that they will be treated as overriding even
+	if the overridden subprogram is marked Is_Hidden, as long as the
+	overridden subprogram's parent subprogram is not hidden.
+
+2010-06-14  Robert Dewar  <dewar@adacore.com>
+
+	* debug.adb: Entry for gnatw.d no longer specific for while loops
+	* einfo.adb (First_Exit_Statement): New attribute for E_Loop
+	* einfo.ads (First_Exit_Statement): New attribute for E_Loop
+	* sem_ch5.adb (Analyze_Loop_Statement): Check_Infinite_Loop_Warning has
+	new calling sequence to include test for EXIT WHEN.
+	(Analyze_Exit_Statement): Chain EXIT statement into exit statement chain
+	* sem_warn.ads, sem_warn.adb (Check_Infinite_Loop_Warning): Now handles
+	EXIT WHEN case.
+	* sinfo.adb (Next_Exit_Statement): New attribute of N_Exit_Statement
+	node.
+	* sinfo.ads (N_Pragma): Correct comment on Sloc field (points to
+	PRAGMA, not to pragma identifier).
+	(Next_Exit_Statement): New attribute of N_Exit_Statement node
+
+2010-06-14  Robert Dewar  <dewar@adacore.com>
+
+	* sem_res.adb (Resolve_Short_Circuit): Fix sloc of "assertion/check
+	would fail" msg.
+
+2010-06-14  Robert Dewar  <dewar@adacore.com>
+
+	* par-ch2.adb (Scan_Pragma_Argument_Association): Clarify message for
+	missing pragma argument identifier.
+
+2010-06-14  Robert Dewar  <dewar@adacore.com>
+
+	* atree.ads, atree.adb (Ekind_In): New functions
+
+2010-06-14  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Op_Expon): Optimize 2**N in stand alone context
+
+2010-06-14  Robert Dewar  <dewar@adacore.com>
+
+	* usage.adb (Usage): Redo documentation of -gnatwa.
+
 2010-06-14  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch8.adb (Find_Type): The attribute 'class cannot be applied to
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index b227326..de7bd7e 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -766,6 +766,104 @@ package body Atree is
       return N_To_E (Nodes.Table (E + 1).Nkind);
    end Ekind;
 
+   --------------
+   -- Ekind_In --
+   --------------
+
+   function Ekind_In
+     (T  : Entity_Kind;
+      V1 : Entity_Kind;
+      V2 : Entity_Kind) return Boolean
+   is
+   begin
+      return T = V1 or else
+             T = V2;
+   end Ekind_In;
+
+   function Ekind_In
+     (T  : Entity_Kind;
+      V1 : Entity_Kind;
+      V2 : Entity_Kind;
+      V3 : Entity_Kind) return Boolean
+   is
+   begin
+      return T = V1 or else
+             T = V2 or else
+             T = V3;
+   end Ekind_In;
+
+   function Ekind_In
+     (T  : Entity_Kind;
+      V1 : Entity_Kind;
+      V2 : Entity_Kind;
+      V3 : Entity_Kind;
+      V4 : Entity_Kind) return Boolean
+   is
+   begin
+      return T = V1 or else
+             T = V2 or else
+             T = V3 or else
+             T = V4;
+   end Ekind_In;
+
+   function Ekind_In
+     (T  : Entity_Kind;
+      V1 : Entity_Kind;
+      V2 : Entity_Kind;
+      V3 : Entity_Kind;
+      V4 : Entity_Kind;
+      V5 : Entity_Kind) return Boolean
+   is
+   begin
+      return T = V1 or else
+             T = V2 or else
+             T = V3 or else
+             T = V4 or else
+             T = V5;
+   end Ekind_In;
+
+   function Ekind_In
+     (E  : Entity_Id;
+      V1 : Entity_Kind;
+      V2 : Entity_Kind) return Boolean
+   is
+   begin
+      return Ekind_In (Ekind (E), V1, V2);
+   end Ekind_In;
+
+   function Ekind_In
+     (E  : Entity_Id;
+      V1 : Entity_Kind;
+      V2 : Entity_Kind;
+      V3 : Entity_Kind) return Boolean
+   is
+   begin
+      return Ekind_In (Ekind (E), V1, V2, V3);
+   end Ekind_In;
+
+   function Ekind_In
+     (E  : Entity_Id;
+      V1 : Entity_Kind;
+      V2 : Entity_Kind;
+      V3 : Entity_Kind;
+      V4 : Entity_Kind) return Boolean
+   is
+   begin
+      return Ekind_In (Ekind (E), V1, V2, V3, V4);
+   end Ekind_In;
+
+   function Ekind_In
+     (E  : Entity_Id;
+      V1 : Entity_Kind;
+      V2 : Entity_Kind;
+      V3 : Entity_Kind;
+      V4 : Entity_Kind;
+      V5 : Entity_Kind) return Boolean
+   is
+   begin
+      return Ekind_In (Ekind (E), V1, V2, V3, V4, V5);
+   end Ekind_In;
+
    ------------------
    -- Error_Posted --
    ------------------
diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index da0b288..2f61374 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -543,8 +543,12 @@ package Atree is
    --  Tests given Id for inequality with the Empty node. This allows notations
    --  like "if Present (Statement)" as opposed to "if Statement /= Empty".
 
-   --  Node_Kind tests, like the functions in Sinfo, but the first argument is
-   --  a Node_Id, and the tested field is Nkind (N).
+   ---------------------
+   -- Node_Kind Tests --
+   ---------------------
+
+   --  These are like the functions in Sinfo, but the first argument is a
+   --  Node_Id, and the tested field is Nkind (N).
 
    function Nkind_In
      (N  : Node_Id;
@@ -617,6 +621,70 @@ package Atree is
    pragma Inline (Nkind_In);
    --  Inline all above functions
 
+   -----------------------
+   -- Entity_Kind_Tests --
+   -----------------------
+
+   --  Utility functions to test whether an Entity_Kind value, either given
+   --  directly as the first argument, or the Ekind field of an Entity give
+   --  as the first argument, matches any of the given list of Entity_Kind
+   --  values. Return True if any match, False if no match.
+
+   function Ekind_In
+     (E  : Entity_Id;
+      V1 : Entity_Kind;
+      V2 : Entity_Kind) return Boolean;
+
+   function Ekind_In
+     (E  : Entity_Id;
+      V1 : Entity_Kind;
+      V2 : Entity_Kind;
+      V3 : Entity_Kind) return Boolean;
+
+   function Ekind_In
+     (E  : Entity_Id;
+      V1 : Entity_Kind;
+      V2 : Entity_Kind;
+      V3 : Entity_Kind;
+      V4 : Entity_Kind) return Boolean;
+
+   function Ekind_In
+     (E  : Entity_Id;
+      V1 : Entity_Kind;
+      V2 : Entity_Kind;
+      V3 : Entity_Kind;
+      V4 : Entity_Kind;
+      V5 : Entity_Kind) return Boolean;
+
+   function Ekind_In
+     (T  : Entity_Kind;
+      V1 : Entity_Kind;
+      V2 : Entity_Kind) return Boolean;
+
+   function Ekind_In
+     (T  : Entity_Kind;
+      V1 : Entity_Kind;
+      V2 : Entity_Kind;
+      V3 : Entity_Kind) return Boolean;
+
+   function Ekind_In
+     (T  : Entity_Kind;
+      V1 : Entity_Kind;
+      V2 : Entity_Kind;
+      V3 : Entity_Kind;
+      V4 : Entity_Kind) return Boolean;
+
+   function Ekind_In
+     (T  : Entity_Kind;
+      V1 : Entity_Kind;
+      V2 : Entity_Kind;
+      V3 : Entity_Kind;
+      V4 : Entity_Kind;
+      V5 : Entity_Kind) return Boolean;
+
+   pragma Inline (Ekind_In);
+   --  Inline all above functions
+
    -----------------------------
    -- Entity Access Functions --
    -----------------------------
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index ca207b2..8f08dcc 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -113,7 +113,7 @@ package body Debug is
    --  d.t  Disable static allocation of library level dispatch tables
    --  d.u
    --  d.v  Enable OK_To_Reorder_Components in variant records
-   --  d.w  Do not check for infinite while loops
+   --  d.w  Do not check for infinite loops
    --  d.x  No exception handlers
    --  d.y
    --  d.z
@@ -548,7 +548,7 @@ package body Debug is
    --  d.v  Forces the flag OK_To_Reorder_Components to be set in all record
    --       base types that have at least one discriminant (v = variant).
 
-   --  d.w  This flag turns off the scanning of while loops to detect possible
+   --  d.w  This flag turns off the scanning of loops to detect possible
    --       infinite loops.
 
    --  d.x  No exception handlers in generated code. This causes exception
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index fdc9d27..1fd68b8 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -79,6 +79,7 @@ package body Einfo is
    --    Normalized_First_Bit            Uint8
    --    Postcondition_Proc              Node8
    --    Return_Applies_To               Node8
+   --    First_Exit_Statement            Node8
 
    --    Class_Wide_Type                 Node9
    --    Current_Value                   Node9
@@ -1053,6 +1054,12 @@ package body Einfo is
       return Node17 (Id);
    end First_Entity;
 
+   function First_Exit_Statement (Id : E) return N is
+   begin
+      pragma Assert (Ekind (Id) = E_Loop);
+      return Node8 (Id);
+   end First_Exit_Statement;
+
    function First_Index (Id : E) return N is
    begin
       pragma Assert (Is_Array_Type (Id) or else Is_String_Type (Id));
@@ -3492,6 +3499,12 @@ package body Einfo is
       Set_Node17 (Id, V);
    end Set_First_Entity;
 
+   procedure Set_First_Exit_Statement (Id : E; V : N) is
+   begin
+      pragma Assert (Ekind (Id) = E_Loop);
+      Set_Node8 (Id, V);
+   end Set_First_Exit_Statement;
+
    procedure Set_First_Index (Id : E; V : N) is
    begin
       pragma Assert (Is_Array_Type (Id) or else Is_String_Type (Id));
@@ -7236,6 +7249,9 @@ package body Einfo is
          when Type_Kind                                    =>
             Write_Str ("Associated_Node_For_Itype");
 
+         when E_Loop                                       =>
+            Write_Str ("First_Exit_Statement");
+
          when E_Package                                    =>
             Write_Str ("Dependent_Instances");
 
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index d429472..d9ff8c0 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -1116,6 +1116,13 @@ package Einfo is
 --       Points to a list of associated entities using the Next_Entity field
 --       as a chain pointer with Empty marking the end of the list.
 
+--    First_Exit_Statement (Node8)
+--       Present in E_Loop entity. The exit statements for a loop are chained
+--       (in reverse order of appearence) using this field to point to the
+--       first entry in the chain (last exit statement in the loop). The
+--       entries are chained through the Next_Exit_Statement field of the
+--       N_Exit_Statement node with Empty marking the end of the list.
+
 --    First_Formal (synthesized)
 --       Applies to subprograms and subprogram types, and also in entries
 --       and entry families. Returns first formal of the subprogram or entry.
@@ -5063,6 +5070,7 @@ package Einfo is
    --    (plus type attributes)
 
    --  E_Loop
+   --    First_Exit_Statement                (Node8)
    --    Has_Exit                            (Flag47)
    --    Has_Master_Entity                   (Flag21)
    --    Has_Nested_Block_With_Handler       (Flag101)
@@ -5743,6 +5751,7 @@ package Einfo is
    function Finalization_Chain_Entity           (Id : E) return E;
    function Finalize_Storage_Only               (Id : E) return B;
    function First_Entity                        (Id : E) return E;
+   function First_Exit_Statement                (Id : E) return N;
    function First_Index                         (Id : E) return N;
    function First_Literal                       (Id : E) return E;
    function First_Optional_Parameter            (Id : E) return E;
@@ -6291,6 +6300,7 @@ package Einfo is
    procedure Set_Finalization_Chain_Entity       (Id : E; V : E);
    procedure Set_Finalize_Storage_Only           (Id : E; V : B := True);
    procedure Set_First_Entity                    (Id : E; V : E);
+   procedure Set_First_Exit_Statement            (Id : E; V : N);
    procedure Set_First_Index                     (Id : E; V : N);
    procedure Set_First_Literal                   (Id : E; V : E);
    procedure Set_First_Optional_Parameter        (Id : E; V : E);
@@ -6945,6 +6955,7 @@ package Einfo is
    pragma Inline (Can_Use_Internal_Rep);
    pragma Inline (Finalization_Chain_Entity);
    pragma Inline (First_Entity);
+   pragma Inline (First_Exit_Statement);
    pragma Inline (First_Index);
    pragma Inline (First_Literal);
    pragma Inline (First_Optional_Parameter);
@@ -7376,6 +7387,7 @@ package Einfo is
    pragma Inline (Set_Can_Use_Internal_Rep);
    pragma Inline (Set_Finalization_Chain_Entity);
    pragma Inline (Set_First_Entity);
+   pragma Inline (Set_First_Exit_Statement);
    pragma Inline (Set_First_Index);
    pragma Inline (Set_First_Literal);
    pragma Inline (Set_First_Optional_Parameter);
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index c080220..a8b7854 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -47,6 +47,7 @@ with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
 with Opt;      use Opt;
+with Par_SCO;  use Par_SCO;
 with Restrict; use Restrict;
 with Rident;   use Rident;
 with Rtsfind;  use Rtsfind;
@@ -5066,7 +5067,7 @@ package body Exp_Ch4 is
         and then Is_Power_Of_2_For_Shift (Ropnd)
 
       --  We cannot do this transformation in configurable run time mode if we
-      --  have 64-bit --  integers and long shifts are not available.
+      --  have 64-bit integers and long shifts are not available.
 
         and then
           (Esize (Ltyp) <= 32
@@ -5912,6 +5913,9 @@ package body Exp_Ch4 is
       --  the flag Is_Natural_Power_Of_2_for_Shift set, then the expansion
       --  of the higher level node converts it into a shift.
 
+      --  Another case is 2 ** N in any other context. We simply convert
+      --  this to 1 * 2 ** N, and then the above transformation applies.
+
       --  Note: this transformation is not applicable for a modular type with
       --  a non-binary modulus in the multiplication case, since we get a wrong
       --  result if the shift causes an overflow before the modular reduction.
@@ -5922,33 +5926,45 @@ package body Exp_Ch4 is
         and then Esize (Root_Type (Exptyp)) <= Esize (Standard_Integer)
         and then Is_Unsigned_Type (Exptyp)
         and then not Ovflo
-        and then Nkind (Parent (N)) in N_Binary_Op
       then
-         declare
-            P : constant Node_Id := Parent (N);
-            L : constant Node_Id := Left_Opnd (P);
-            R : constant Node_Id := Right_Opnd (P);
+         --  First the multiply and divide cases
 
-         begin
-            if (Nkind (P) = N_Op_Multiply
-                 and then not Non_Binary_Modulus (Typ)
-                 and then
-                   ((Is_Integer_Type (Etype (L)) and then R = N)
-                       or else
-                    (Is_Integer_Type (Etype (R)) and then L = N))
-                 and then not Do_Overflow_Check (P))
-
-              or else
-                (Nkind (P) = N_Op_Divide
-                  and then Is_Integer_Type (Etype (L))
-                  and then Is_Unsigned_Type (Etype (L))
-                  and then R = N
-                  and then not Do_Overflow_Check (P))
-            then
-               Set_Is_Power_Of_2_For_Shift (N);
-               return;
-            end if;
-         end;
+         if Nkind_In (Parent (N), N_Op_Divide, N_Op_Multiply) then
+            declare
+               P : constant Node_Id := Parent (N);
+               L : constant Node_Id := Left_Opnd (P);
+               R : constant Node_Id := Right_Opnd (P);
+
+            begin
+               if (Nkind (P) = N_Op_Multiply
+                   and then not Non_Binary_Modulus (Typ)
+                   and then
+                     ((Is_Integer_Type (Etype (L)) and then R = N)
+                         or else
+                      (Is_Integer_Type (Etype (R)) and then L = N))
+                   and then not Do_Overflow_Check (P))
+                 or else
+                  (Nkind (P) = N_Op_Divide
+                     and then Is_Integer_Type (Etype (L))
+                     and then Is_Unsigned_Type (Etype (L))
+                     and then R = N
+                     and then not Do_Overflow_Check (P))
+               then
+                  Set_Is_Power_Of_2_For_Shift (N);
+                  return;
+               end if;
+            end;
+
+         --  Now the other cases
+
+         elsif not Non_Binary_Modulus (Typ) then
+            Rewrite (N,
+              Make_Op_Multiply (Loc,
+                Left_Opnd  => Make_Integer_Literal (Loc, 1),
+                Right_Opnd => Relocate_Node (N)));
+            Analyze_And_Resolve (N, Typ);
+            return;
+         end if;
       end if;
 
       --  Fall through if exponentiation must be done using a runtime routine
@@ -8745,6 +8761,12 @@ package body Exp_Ch4 is
 
       if Compile_Time_Known_Value (Left) then
 
+         --  Mark SCO for left condition as compile time known
+
+         if Generate_SCO and then Comes_From_Source (Left) then
+            Set_SCO_Condition (Left, Expr_Value_E (Left) = Standard_True);
+         end if;
+
          --  Rewrite True AND THEN Right / False OR ELSE Right to Right.
          --  Any actions associated with Right will be executed unconditionally
          --  and can thus be inserted into the tree unconditionally.
@@ -8830,6 +8852,12 @@ package body Exp_Ch4 is
 
       if Compile_Time_Known_Value (Right) then
 
+         --  Mark SCO for left condition as compile time known
+
+         if Generate_SCO and then Comes_From_Source (Right) then
+            Set_SCO_Condition (Right, Expr_Value_E (Right) = Standard_True);
+         end if;
+
          --  Change (Left and then True), (Left or else False) to Left.
          --  Note that we know there are no actions associated with the right
          --  operand, since we just checked for this case above.
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 4581116..90b4459 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -224,7 +224,10 @@ package Opt is
    --  GNAT
    --  This points to the list of N_Pragma nodes for Check_Policy pragmas
    --  that are linked through the Next_Pragma fields, with the list being
-   --  terminated by Empty. The order is most recently processed first.
+   --  terminated by Empty. The order is most recently processed first. Note
+   --  that Push_Scope and Pop_Scope in Sem_Ch8 save and restore the value
+   --  of this variable, implementing the required scope control for pragmas
+   --  appearing a declarative part.
 
    Check_Readonly_Files : Boolean := False;
    --  GNATMAKE
diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb
index e96c379..def8ef5 100644
--- a/gcc/ada/par-ch2.adb
+++ b/gcc/ada/par-ch2.adb
@@ -503,7 +503,9 @@ package body Ch2 is
 
       if Identifier_Seen and not Id_Present then
          Error_Msg_SC
-           ("|pragma argument identifier required here (RM 2.8(4))");
+           ("|pragma argument identifier required here");
+         Error_Msg_SC
+           ("\since previous argument had identifier (RM 2.8(4))");
       end if;
 
       if Id_Present then
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 1f6806b..44909e2 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -1209,6 +1209,11 @@ package body Sem_Ch5 is
          Check_Unset_Reference (Cond);
       end if;
 
+      --  Chain exit statement to associated loop entity
+
+      Set_Next_Exit_Statement  (N, First_Exit_Statement (Scope_Id));
+      Set_First_Exit_Statement (Scope_Id, N);
+
       --  Since the exit may take us out of a loop, any previous assignment
       --  statement is not useless, so clear last assignment indications. It
       --  is OK to keep other current values, since if the exit statement
@@ -2060,8 +2065,12 @@ package body Sem_Ch5 is
       End_Scope;
       Kill_Current_Values;
 
-      --  Check for infinite loop. We skip this check for generated code, since
-      --  it justs waste time and makes debugging the routine called harder.
+      --  Check for infinite loop. Skip check for generated code, since it
+      --  justs waste time and makes debugging the routine called harder.
+
+      --  Note that we have to wait till the body of the loop is fully analyzed
+      --  before making this call, since Check_Infinite_Loop_Warning relies on
+      --  being able to use semantic visibility information to find references.
 
       if Comes_From_Source (N) then
          Check_Infinite_Loop_Warning (N);
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index a263d82..befa1d4 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -4420,8 +4420,24 @@ package body Sem_Ch6 is
          end;
       end if;
 
+      --  If there is an overridden subprogram, then check that there is not
+      --  a "not overriding" indicator, and mark the subprogram as overriding.
+      --  This is not done if the overridden subprogram is marked as hidden,
+      --  which can occur for the case of inherited controlled operations
+      --  (see Derive_Subprogram), unless the inherited subprogram's parent
+      --  subprogram is not itself hidden. (Note: This condition could probably
+      --  be simplified, leaving out the testing for the specific controlled
+      --  cases, but it seems safer and clearer this way, and echoes similar
+      --  special-case tests of this kind in other places.)
+
       if Present (Overridden_Subp)
-        and then not Is_Hidden (Overridden_Subp)
+        and then (not Is_Hidden (Overridden_Subp)
+                   or else
+                     ((Chars (Overridden_Subp) = Name_Initialize
+                         or else Chars (Overridden_Subp) = Name_Adjust
+                         or else Chars (Overridden_Subp) = Name_Finalize)
+                       and then Present (Alias (Overridden_Subp))
+                       and then not Is_Hidden (Alias (Overridden_Subp))))
       then
          if Must_Not_Override (Spec) then
             Error_Msg_Sloc := Sloc (Overridden_Subp);
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 065be11..0e8157a 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -5771,8 +5771,13 @@ package body Sem_Prag is
             end if;
 
             Check_Arg_Is_Identifier (Arg1);
+
+            --  Indicate if pragma is enabled. The Original_Node reference here
+            --  is to deal with pragma Assert rewritten as a Check pragma.
+
             Check_On := Check_Enabled (Chars (Get_Pragma_Arg (Arg1)));
             Set_Pragma_Enabled (N, Check_On);
+            Set_Pragma_Enabled (Original_Node (N), Check_On);
 
             --  If expansion is active and the check is not enabled then we
             --  rewrite the Check as:
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index feee853..0e23492 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -7846,15 +7846,15 @@ package body Sem_Res is
                   then
                      null;
                   else
-                     --  Issue warning. Note that we don't want to make this
-                     --  an unconditional warning, because if the assert is
-                     --  within deleted code we do not want the warning. But
-                     --  we do not want the deletion of the IF/AND-THEN to
-                     --  take this message with it. We achieve this by making
-                     --  sure that the expanded code points to the Sloc of
-                     --  the expression, not the original pragma.
-
-                     Error_Msg_N ("?assertion would fail at run-time", Orig);
+                     --  Issue warning. We do not want the deletion of the
+                     --  IF/AND-THEN to take this message with it. We achieve
+                     --  this by making sure that the expanded code points to
+                     --  the Sloc of the expression, not the original pragma.
+
+                     Error_Msg_N
+                       ("?assertion would fail at run-time!",
+                        Expression
+                          (First (Pragma_Argument_Associations (Orig))));
                   end if;
                end;
 
@@ -7877,7 +7877,10 @@ package body Sem_Res is
                   then
                      null;
                   else
-                     Error_Msg_N ("?check would fail at run-time", Orig);
+                     Error_Msg_N
+                       ("?check would fail at run-time!",
+                        Expression
+                          (Last (Pragma_Argument_Associations (Orig))));
                   end if;
                end;
             end if;
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 580ba9a..841f5dd 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -234,10 +234,11 @@ package body Sem_Warn is
    --  within the body of the loop.
 
    procedure Check_Infinite_Loop_Warning (Loop_Statement : Node_Id) is
-      Iter : constant Node_Id := Iteration_Scheme (Loop_Statement);
+      Expression : Node_Id := Empty;
+      --  Set to WHILE or EXIT WHEN condition to be tested
 
       Ref : Node_Id := Empty;
-      --  Reference in iteration scheme to variable that might not be modified
+      --  Reference in Expression to variable that might not be modified
       --  in loop, indicating a possible infinite loop.
 
       Var : Entity_Id := Empty;
@@ -267,9 +268,9 @@ package body Sem_Warn is
 
       function Test_Ref (N : Node_Id) return Traverse_Result;
       --  Test for reference to variable in question. Returns Abandon if
-      --  matching reference found.
+      --  matching reference found. Used in instantiation of No_Ref_Found.
 
-      function Find_Ref is new Traverse_Func (Test_Ref);
+      function No_Ref_Found is new Traverse_Func (Test_Ref);
       --  Function to traverse body of procedure. Returns Abandon if matching
       --  reference found.
 
@@ -465,9 +466,9 @@ package body Sem_Warn is
 
       function Test_Ref (N : Node_Id) return Traverse_Result is
       begin
-         --  Waste of time to look at iteration scheme
+         --  Waste of time to look at the expression we are testing
 
-         if N = Iter then
+         if N = Expression then
             return Skip;
 
          --  Direct reference to variable in question
@@ -547,20 +548,86 @@ package body Sem_Warn is
    --  Start of processing for Check_Infinite_Loop_Warning
 
    begin
-      --  We need a while iteration with no condition actions. Condition
-      --  actions just make things too complicated to get the warning right.
+      --  Skip processing if debug flag gnatd.w is set
 
-      if No (Iter)
-        or else No (Condition (Iter))
-        or else Present (Condition_Actions (Iter))
-        or else Debug_Flag_Dot_W
-      then
+      if Debug_Flag_Dot_W then
+         return;
+      end if;
+
+      --  Case of WHILE loop
+
+      declare
+         Iter : constant Node_Id := Iteration_Scheme (Loop_Statement);
+
+      begin
+         if Present (Iter) and then Present (Condition (Iter)) then
+
+            --  Skip processing for while iteration with conditions actions,
+            --  since they make it too complicated to get the warning right.
+
+            if Present (Condition_Actions (Iter)) then
+               return;
+            end if;
+
+            --  Capture WHILE condition
+
+            Expression := Condition (Iter);
+         end if;
+      end;
+
+      --  Check chain of EXIT statements, we only process loops that have a
+      --  single exit condition (either a single EXIT WHEN statement, or a
+      --  WHILE loop not containing any EXIT WHEN statements).
+
+      declare
+         Ident     : constant Node_Id := Identifier (Loop_Statement);
+         Exit_Stmt : Node_Id;
+
+      begin
+         --  If we don't have a proper chain set, ignore call entirely. This
+         --  happens because of previous errors.
+
+         if No (Entity (Ident))
+           or else Ekind (Entity (Ident)) /= E_Loop
+         then
+            return;
+         end if;
+
+         --  Otherwise prepare to scan list of EXIT statements
+
+         Exit_Stmt := First_Exit_Statement (Entity (Ident));
+         while Present (Exit_Stmt) loop
+
+            --  Check for EXIT WHEN
+
+            if Present (Condition (Exit_Stmt)) then
+
+               --  Quit processing if EXIT WHEN in WHILE loop, or more than
+               --  one EXIT WHEN statement present in the loop.
+
+               if Present (Expression) then
+                  return;
+
+               --  Otherwise capture condition from EXIT WHEN statement
+
+               else
+                  Expression := Condition (Exit_Stmt);
+               end if;
+            end if;
+
+            Exit_Stmt := Next_Exit_Statement (Exit_Stmt);
+         end loop;
+      end;
+
+      --  Return if no condition to test
+
+      if No (Expression) then
          return;
       end if;
 
       --  Initial conditions met, see if condition is of right form
 
-      Find_Var (Condition (Iter));
+      Find_Var (Expression);
 
       --  Nothing to do if local variable from source not found. If it's a
       --  renaming, it is probably renaming something too complicated to deal
@@ -608,7 +675,7 @@ package body Sem_Warn is
       --  We have a variable reference of the right form, now we scan the loop
       --  body to see if it looks like it might not be modified
 
-      if Find_Ref (Loop_Statement) = OK then
+      if No_Ref_Found (Loop_Statement) = OK then
          Error_Msg_NE
            ("?variable& is not modified in loop body!", Ref, Var);
          Error_Msg_N
@@ -3432,9 +3499,7 @@ package body Sem_Warn is
             Sloc_Range (Orig, Start, Dummy);
             Atrue := Test_Result;
 
-            if Present (Parent (C))
-              and then Nkind (Parent (C)) = N_Op_Not
-            then
+            if Present (Parent (C)) and then Nkind (Parent (C)) = N_Op_Not then
                Atrue := not Atrue;
             end if;
 
diff --git a/gcc/ada/sem_warn.ads b/gcc/ada/sem_warn.ads
index 365ad39..e74e144 100644
--- a/gcc/ada/sem_warn.ads
+++ b/gcc/ada/sem_warn.ads
@@ -170,7 +170,8 @@ package Sem_Warn is
 
    procedure Check_Infinite_Loop_Warning (Loop_Statement : Node_Id);
    --  N is the node for a loop statement. This procedure checks if a warning
-   --  should be given for a possible infinite loop, and if so issues it.
+   --  for a possible infinite loop should be given for a suspicious WHILE or
+   --  EXIT WHEN condition.
 
    procedure Check_Low_Bound_Tested (Expr : Node_Id);
    --  Expr is the node for a comparison operation. This procedure checks if
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 5a431cd..57f8f93 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -2021,6 +2021,14 @@ package body Sinfo is
       return Node2 (N);
    end Next_Entity;
 
+   function Next_Exit_Statement
+     (N : Node_Id) return Node_Id is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Exit_Statement);
+      return Node3 (N);
+   end Next_Exit_Statement;
+
    function Next_Implicit_With
      (N : Node_Id) return Node_Id is
    begin
@@ -4907,6 +4915,14 @@ package body Sinfo is
       Set_Node2 (N, Val); -- semantic field, no parent set
    end Set_Next_Entity;
 
+   procedure Set_Next_Exit_Statement
+      (N : Node_Id; Val : Node_Id) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Exit_Statement);
+      Set_Node3 (N, Val); -- semantic field, no parent set
+   end Set_Next_Exit_Statement;
+
    procedure Set_Next_Implicit_With
       (N : Node_Id; Val : Node_Id) is
    begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index a5b5a3e..31f555b 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1395,6 +1395,12 @@ package Sinfo is
    --    scope are chained, and this field is used as the forward pointer for
    --    this list. See Einfo for further details.
 
+   --  Next_Exit_Statement (Node3-Sem)
+   --    Present in N_Exit_Statement nodes. The exit statements for a loop are
+   --    chained (in reverse order of appearence) from the First_Exit_Statement
+   --    field of the E_Loop entity for the loop. Next_Exit_Statement points to
+   --    the next entry on this chain (Empty = end of list).
+
    --  Next_Implicit_With (Node3-Sem)
    --    Present in N_With_Clause. Part of a chain of with_clauses generated
    --    in rtsfind to indicate implicit dependencies on predefined units. Used
@@ -1980,7 +1986,7 @@ package Sinfo is
       --  which are explicitly documented.
 
       --  N_Pragma
-      --  Sloc points to pragma identifier
+      --  Sloc points to PRAGMA
       --  Next_Pragma (Node1-Sem)
       --  Pragma_Argument_Associations (List2) (set to No_List if none)
       --  Debug_Statement (Node3) (set to Empty if not Debug, Assert)
@@ -4040,6 +4046,13 @@ package Sinfo is
       --  Is_Null_Loop (Flag16)
       --  Suppress_Loop_Warnings (Flag17)
 
+      --  Note: the parser fills in the Identifier field if there is an
+      --  explicit loop identifier. Otherwise the parser leaves this field
+      --  set to Empty, and then the semantic processing for a loop statement
+      --  creates an identifier, setting the Has_Created_Identifier flag to
+      --  True. So after semantic anlaysis, the Identifier is always set,
+      --  referencing an identifier whose entity has an Ekind of E_Loop.
+
       --------------------------
       -- 5.5 Iteration Scheme --
       --------------------------
@@ -4128,7 +4141,8 @@ package Sinfo is
       --  N_Exit_Statement
       --  Sloc points to EXIT
       --  Name (Node2) (set to Empty if no loop name present)
-      --  Condition (Node1) (set to Empty if no when part present)
+      --  Condition (Node1) (set to Empty if no WHEN part present)
+      --  Next_Exit_Statement (Node3-Sem): Next exit on chain
 
       -------------------------
       -- 5.9  Goto Statement --
@@ -8247,6 +8261,9 @@ package Sinfo is
    function Next_Entity
      (N : Node_Id) return Node_Id;    -- Node2
 
+   function Next_Exit_Statement
+     (N : Node_Id) return Node_Id;    -- Node3
+
    function Next_Implicit_With
      (N : Node_Id) return Node_Id;    -- Node3
 
@@ -9168,6 +9185,9 @@ package Sinfo is
    procedure Set_Next_Entity
      (N : Node_Id; Val : Node_Id);            -- Node2
 
+   procedure Set_Next_Exit_Statement
+     (N : Node_Id; Val : Node_Id);            -- Node3
+
    procedure Set_Next_Implicit_With
      (N : Node_Id; Val : Node_Id);            -- Node3
 
@@ -11360,6 +11380,7 @@ package Sinfo is
    pragma Inline (Name);
    pragma Inline (Names);
    pragma Inline (Next_Entity);
+   pragma Inline (Next_Exit_Statement);
    pragma Inline (Next_Implicit_With);
    pragma Inline (Next_Named_Actual);
    pragma Inline (Next_Pragma);
@@ -11664,6 +11685,7 @@ package Sinfo is
    pragma Inline (Set_Name);
    pragma Inline (Set_Names);
    pragma Inline (Set_Next_Entity);
+   pragma Inline (Set_Next_Exit_Statement);
    pragma Inline (Set_Next_Implicit_With);
    pragma Inline (Set_Next_Named_Actual);
    pragma Inline (Set_Next_Pragma);
diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb
index 1840ade..9e2b3c4 100644
--- a/gcc/ada/usage.adb
+++ b/gcc/ada/usage.adb
@@ -397,47 +397,46 @@ begin
 
    Write_Switch_Char ("wxx");
    Write_Line ("Enable selected warning modes, xx = list of parameters:");
-   Write_Line ("        a    turn on all optional info/warnings " &
-                                                  "(except dhl.ot.w)");
+   Write_Line ("        a    turn on all info/warnings marked below with +");
    Write_Line ("        A    turn off all optional info/warnings");
-   Write_Line ("        .a*  turn on warnings for failing assertion");
+   Write_Line ("        .a*+ turn on warnings for failing assertion");
    Write_Line ("        .A   turn off warnings for failing assertion");
-   Write_Line ("        b    turn on warnings for bad fixed value " &
+   Write_Line ("        b+   turn on warnings for bad fixed value " &
                                                   "(not multiple of small)");
    Write_Line ("        B*   turn off warnings for bad fixed value " &
                                                   "(not multiple of small)");
-   Write_Line ("        .b*  turn on warnings for biased representation");
+   Write_Line ("        .b*+ turn on warnings for biased representation");
    Write_Line ("        .B   turn off warnings for biased representation");
-   Write_Line ("        c    turn on warnings for constant conditional");
+   Write_Line ("        c+   turn on warnings for constant conditional");
    Write_Line ("        C*   turn off warnings for constant conditional");
-   Write_Line ("        .c   turn on warnings for unrepped components");
+   Write_Line ("        .c+  turn on warnings for unrepped components");
    Write_Line ("        .C*  turn off warnings for unrepped components");
    Write_Line ("        d    turn on warnings for implicit dereference");
    Write_Line ("        D*   turn off warnings for implicit dereference");
    Write_Line ("        e    treat all warnings (but not info) as errors");
    Write_Line ("        .e   turn on every optional info/warning " &
                                                   "(no exceptions)");
-   Write_Line ("        f    turn on warnings for unreferenced formal");
+   Write_Line ("        f+   turn on warnings for unreferenced formal");
    Write_Line ("        F*   turn off warnings for unreferenced formal");
-   Write_Line ("        g*   turn on warnings for unrecognized pragma");
+   Write_Line ("        g*+  turn on warnings for unrecognized pragma");
    Write_Line ("        G    turn off warnings for unrecognized pragma");
    Write_Line ("        h    turn on warnings for hiding variable");
    Write_Line ("        H*   turn off warnings for hiding variable");
-   Write_Line ("        i*   turn on warnings for implementation unit");
+   Write_Line ("        i*+  turn on warnings for implementation unit");
    Write_Line ("        I    turn off warnings for implementation unit");
    Write_Line ("        .i   turn on warnings for overlapping actuals");
    Write_Line ("        .I*  turn off warnings for overlapping actuals");
-   Write_Line ("        j    turn on warnings for obsolescent " &
+   Write_Line ("        j+   turn on warnings for obsolescent " &
                                                   "(annex J) feature");
    Write_Line ("        J*   turn off warnings for obsolescent " &
                                                   "(annex J) feature");
-   Write_Line ("        k    turn on warnings on constant variable");
+   Write_Line ("        k+   turn on warnings on constant variable");
    Write_Line ("        K*   turn off warnings on constant variable");
    Write_Line ("        l    turn on warnings for missing " &
                                                   "elaboration pragma");
    Write_Line ("        L*   turn off warnings for missing " &
                                                   "elaboration pragma");
-   Write_Line ("        m    turn on warnings for variable assigned " &
+   Write_Line ("        m+   turn on warnings for variable assigned " &
                                                   "but not read");
    Write_Line ("        M*   turn off warnings for variable assigned " &
                                                   "but not read");
@@ -450,47 +449,48 @@ begin
                                                   "but not read");
    Write_Line ("        .O*  turn off warnings for out parameters assigned " &
                                                   "but not read");
-   Write_Line ("        p    turn on warnings for ineffective pragma " &
+   Write_Line ("        p+   turn on warnings for ineffective pragma " &
                                                   "Inline in frontend");
    Write_Line ("        P*   turn off warnings for ineffective pragma " &
                                                   "Inline in frontend");
-   Write_Line ("        .p   turn on warnings for suspicious parameter " &
+   Write_Line ("        .p+  turn on warnings for suspicious parameter " &
                                                   "order");
    Write_Line ("        .P*  turn off warnings for suspicious parameter " &
                                                   "order");
-   Write_Line ("        q*   turn on warnings for questionable " &
+   Write_Line ("        q*+  turn on warnings for questionable " &
                                                   "missing parenthesis");
    Write_Line ("        Q    turn off warnings for questionable " &
                                                   "missing parenthesis");
-   Write_Line ("        r    turn on warnings for redundant construct");
+   Write_Line ("        r+   turn on warnings for redundant construct");
    Write_Line ("        R*   turn off warnings for redundant construct");
-   Write_Line ("        .r   turn on warnings for object renaming function");
+   Write_Line ("        .r+  turn on warnings for object renaming function");
    Write_Line ("        .R*  turn off warnings for object renaming function");
    Write_Line ("        s    suppress all info/warnings");
    Write_Line ("        t    turn on warnings for tracking deleted code");
    Write_Line ("        T*   turn off warnings for tracking deleted code");
-   Write_Line ("        u    turn on warnings for unused entity");
+   Write_Line ("        u+   turn on warnings for unused entity");
    Write_Line ("        U*   turn off warnings for unused entity");
-   Write_Line ("        v*   turn on warnings for unassigned variable");
+   Write_Line ("        v*+  turn on warnings for unassigned variable");
    Write_Line ("        V    turn off warnings for unassigned variable");
-   Write_Line ("        .v*  turn on info messages for reverse bit order");
+   Write_Line ("        .v*+ turn on info messages for reverse bit order");
    Write_Line ("        .V   turn off info messages for reverse bit order");
-   Write_Line ("        w*   turn on warnings for wrong low bound assumption");
+   Write_Line ("        w*+  turn on warnings for wrong low bound assumption");
    Write_Line ("        W    turn off warnings for wrong low bound " &
                                                   "assumption");
    Write_Line ("        .w   turn on warnings on pragma Warnings Off");
    Write_Line ("        .W*  turn off warnings on pragma Warnings Off");
-   Write_Line ("        x*   turn on warnings for export/import");
+   Write_Line ("        x*+  turn on warnings for export/import");
    Write_Line ("        X    turn off warnings for export/import");
-   Write_Line ("        .x   turn on warnings for non-local exception");
+   Write_Line ("        .x+  turn on warnings for non-local exception");
    Write_Line ("        .X*  turn off warnings for non-local exception");
-   Write_Line ("        y*   turn on warnings for Ada 2005 incompatibility");
+   Write_Line ("        y*+  turn on warnings for Ada 2005 incompatibility");
    Write_Line ("        Y    turn off warnings for Ada 2005 incompatibility");
-   Write_Line ("        z*   turn on warnings for suspicious " &
+   Write_Line ("        z*+  turn on warnings for suspicious " &
                                                   "unchecked conversion");
    Write_Line ("        Z    turn off warnings for suspicious " &
                                                   "unchecked conversion");
    Write_Line ("        *    indicates default in above list");
+   Write_Line ("        +    indicates warning flag included in -gnatwa");
 
    --  Line for -gnatW switch