[multiple changes]

2011-10-24  Geert Bosch  <bosch@adacore.com>

	* s-gearop.adb (Back_Substitute): Avoid overflow if matrix
	bounds start at Integer'First.

2011-10-24  Robert Dewar  <dewar@adacore.com>

	* sem_ch12.adb, s-gearop.adb: Minor reformatting

2011-10-24  Robert Dewar  <dewar@adacore.com>

	* warnsw.adb: Add some missing warnings to Set_GNAT_Mode_Warnings
	* warnsw.ads: Add comments to Set_GNAT_Mode_Warnings

From-SVN: r180372

gcc/ada/ChangeLog

+2011-10-24  Geert Bosch  <bosch@adacore.com>
+
+	* s-gearop.adb (Back_Substitute): Avoid overflow if matrix
+	bounds start at Integer'First.
+
+2011-10-24  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch12.adb, s-gearop.adb: Minor reformatting
+
+2011-10-24  Robert Dewar  <dewar@adacore.com>
+
+	* warnsw.adb: Add some missing warnings to Set_GNAT_Mode_Warnings
+	* warnsw.ads: Add comments to Set_GNAT_Mode_Warnings
+
 2011-10-24  Emmanuel Briot  <briot@adacore.com>
 
 	* prj-proc.adb (Process_Expression_Variable_Decl): No special

gcc/ada/s-gearop.adb

@@ -33,11 +33,11 @@ with Ada.Numerics; use Ada.Numerics;
 
 package body System.Generic_Array_Operations is
 
-   --  The local function Check_Unit_Last computes the index
-   --  of the last element returned by Unit_Vector or Unit_Matrix.
-   --  A separate function is needed to allow raising Constraint_Error
-   --  before declaring the function result variable. The result variable
-   --  needs to be declared first, to allow front-end inlining.
+   --  The local function Check_Unit_Last computes the index of the last
+   --  element returned by Unit_Vector or Unit_Matrix. A separate function is
+   --  needed to allow raising Constraint_Error before declaring the function
+   --  result variable. The result variable needs to be declared first, to
+   --  allow front-end inlining.
 
    function Check_Unit_Last
      (Index : Integer;
@@ -50,7 +50,6 @@ package body System.Generic_Array_Operations is
    --------------
 
    function Diagonal (A : Matrix) return Vector is
-
       N : constant Natural := Natural'Min (A'Length (1), A'Length (2));
       R : Vector (A'First (1) .. A'First (1) + N - 1);
 
@@ -82,7 +81,8 @@ package body System.Generic_Array_Operations is
    function Check_Unit_Last
       (Index : Integer;
        Order : Positive;
-       First : Integer) return Integer is
+       First : Integer) return Integer
+   is
    begin
       --  Order the tests carefully to avoid overflow
 
@@ -101,11 +101,10 @@ package body System.Generic_Array_Operations is
    ---------------------
 
    procedure Back_Substitute (M, N : in out Matrix) is
-      pragma Assert (M'First (1) = N'First (1) and then
+      pragma Assert (M'First (1) = N'First (1)
+                       and then
                      M'Last  (1) = N'Last (1));
 
-      Max_Col : Integer := M'Last (2);
-
       procedure Sub_Row
         (M      : in out Matrix;
          Target : Integer;
@@ -126,27 +125,47 @@ package body System.Generic_Array_Operations is
          end loop;
       end Sub_Row;
 
+      --  Local declarations
+
+      Max_Col : Integer := M'Last (2);
+
    --  Start of processing for Back_Substitute
 
    begin
-      for Row in reverse M'Range (1) loop
-         Find_Non_Zero : for Col in M'First (2) .. Max_Col loop
+      Do_Rows : for Row in reverse M'Range (1) loop
+         Find_Non_Zero : for Col in reverse M'First (2) .. Max_Col loop
             if Is_Non_Zero (M (Row, Col)) then
 
-               --  Found first non-zero element, so subtract a multiple
-               --  of this row from all higher rows, to reduce all other
-               --  elements in this column to zero.
+               --  Found first non-zero element, so subtract a multiple of this
+               --  element  from all higher rows, to reduce all other elements
+               --  in this column to zero.
+
+               declare
+                  --  We can't use a for loop, as we'd need to iterate to
+                  --  Row - 1, but that expression will overflow if M'First
+                  --  equals Integer'First, which is true for aggregates
+                  --  without explicit bounds..
 
-               for J in M'First (1) .. Row - 1 loop
+                  J : Integer := M'First (1);
+
+               begin
+                  while J < Row loop
                      Sub_Row (N, J, Row, (M (J, Col) / M (Row, Col)));
                      Sub_Row (M, J, Row, (M (J, Col) / M (Row, Col)));
+                     J := J + 1;
                   end loop;
+               end;
+
+               --  Avoid potential overflow in the subtraction below
+
+               exit Do_Rows when Col = M'First (2);
 
                Max_Col := Col - 1;
+
                exit Find_Non_Zero;
             end if;
          end loop Find_Non_Zero;
-      end loop;
+      end loop Do_Rows;
    end Back_Substitute;
 
    -----------------------
@@ -158,7 +177,8 @@ package body System.Generic_Array_Operations is
       N   : in out Matrix;
       Det : out Scalar)
    is
-      pragma Assert (M'First (1) = N'First (1) and then
+      pragma Assert (M'First (1) = N'First (1)
+                       and then
                      M'Last  (1) = N'Last (1));
 
       --  The following are variations of the elementary matrix row operations:
@@ -220,8 +240,8 @@ package body System.Generic_Array_Operations is
          end loop;
 
          for J in N'Range (2) loop
-            N (Row - M'First (1) + N'First (1), J)
-               := N (Row - M'First (1) + N'First (1), J) / Scale;
+            N (Row - M'First (1) + N'First (1), J) :=
+              N (Row - M'First (1) + N'First (1), J) / Scale;
          end loop;
       end Divide_Row;
 
@@ -261,6 +281,8 @@ package body System.Generic_Array_Operations is
          end if;
       end Switch_Row;
 
+      --  Local declarations
+
       Row : Integer := M'First (1);
 
    --  Start of processing for Forward_Eliminate
@@ -301,7 +323,9 @@ package body System.Generic_Array_Operations is
                Row := Row + 1;
 
             else
-               Det := Zero; --  Zero, but we don't have literals
+               --  Set zero (note that we do not have literals)
+
+               Det := Zero;
             end if;
          end;
       end loop;
@@ -313,8 +337,7 @@ package body System.Generic_Array_Operations is
 
    function Inner_Product
      (Left  : Left_Vector;
-      Right : Right_Vector)
-      return  Result_Scalar
+      Right : Right_Vector) return  Result_Scalar
    is
       R : Result_Scalar := Zero;
 
@@ -337,6 +360,7 @@ package body System.Generic_Array_Operations is
 
    function L2_Norm (X : X_Vector) return Result_Real'Base is
       Sum : Result_Real'Base := 0.0;
+
    begin
       for J in X'Range loop
          Sum := Sum + Result_Real'Base (abs X (J))**2;
@@ -383,14 +407,14 @@ package body System.Generic_Array_Operations is
 
    function Matrix_Matrix_Elementwise_Operation
      (Left  : Left_Matrix;
-      Right : Right_Matrix)
-      return Result_Matrix
+      Right : Right_Matrix) return Result_Matrix
    is
       R : Result_Matrix (Left'Range (1), Left'Range (2));
 
    begin
       if Left'Length (1) /= Right'Length (1)
-        or else Left'Length (2) /= Right'Length (2)
+           or else
+         Left'Length (2) /= Right'Length (2)
       then
          raise Constraint_Error with
            "matrices are of different dimension in elementwise operation";
@@ -423,7 +447,8 @@ package body System.Generic_Array_Operations is
 
    begin
       if X'Length (1) /= Y'Length (1)
-        or else X'Length (2) /= Y'Length (2)
+           or else
+         X'Length (2) /= Y'Length (2)
       then
          raise Constraint_Error with
            "matrices are of different dimension in elementwise operation";
@@ -584,6 +609,7 @@ package body System.Generic_Array_Operations is
          end if;
 
       elsif X > Real'Base'Last then
+
          --  X is infinity, which is its own square root
 
          return X;
@@ -639,8 +665,8 @@ package body System.Generic_Array_Operations is
 
             begin
                for M in Left'Range (2) loop
-                  S := S + Left (J, M)
-                            * Right (M - Left'First (2) + Right'First (1), K);
+                  S := S + Left (J, M) *
+                             Right (M - Left'First (2) + Right'First (1), K);
                end loop;
 
                R (J, K) := S;

gcc/ada/sem_ch12.adb

@@ -8058,6 +8058,8 @@ package body Sem_Ch12 is
 
          exit when Present (Interface_Alias (Prim_G));
 
+         --  Here we install one hidden primitive
+
          if Chars (Prim_G) /= Chars (Prim_A)
            and then Has_Suffix (Prim_A, 'P')
            and then Remove_Suffix (Prim_A, 'P') = Chars (Prim_G)
@@ -8076,7 +8078,7 @@ package body Sem_Ch12 is
       end loop;
 
       --  Append the elements to the list of temporarily visible primitives
-      --  avoiding duplicates
+      --  avoiding duplicates.
 
       if Present (List) then
          if No (Prims_List) then

gcc/ada/warnsw.adb

@@ -212,12 +212,16 @@ package body Warnsw is
       Warn_On_Modified_Unread             := True;
       Warn_On_No_Value_Assigned           := True;
       Warn_On_Non_Local_Exception         := False;
-      Warn_On_Object_Renames_Function     := False;
+      Warn_On_Object_Renames_Function     := True;
       Warn_On_Obsolescent_Feature         := True;
+      Warn_On_Overlap                     := True;
+      Warn_On_Overridden_Size             := True;
+      Warn_On_Parameter_Order             := True;
       Warn_On_Questionable_Missing_Parens := True;
+      Warn_On_Record_Holes                := False;
       Warn_On_Redundant_Constructs        := True;
       Warn_On_Reverse_Bit_Order           := False;
-      Warn_On_Object_Renames_Function     := True;
+      Warn_On_Suspicious_Contract         := True;
       Warn_On_Unchecked_Conversion        := True;
       Warn_On_Unordered_Enumeration_Type  := False;
       Warn_On_Unrecognized_Pragma         := True;

gcc/ada/warnsw.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1999-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1999-2011, 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- --
@@ -65,6 +65,10 @@ package Warnsw is
 
    procedure Set_GNAT_Mode_Warnings;
    --  This is called in -gnatg mode to set the warnings for gnat mode. It is
-   --  also used to set the proper warning statuses for -gnatw.g.
+   --  also used to set the proper warning statuses for -gnatw.g. Note that
+   --  this set of warnings is disjoint from -gnatwa, it enables warnings that
+   --  are not included in -gnatwa, and it disables warnings that are included
+   --  in -gnatwa (such as Warn_On_Implementation_Units, which we clearly want
+   --  to be False for units built with -gnatg).
 
 end Warnsw;