[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

5 files changed, 103 insertions, 53 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3a21df4..a226bb8 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,17 @@
+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
diff --git a/gcc/ada/s-gearop.adb b/gcc/ada/s-gearop.adb
index 58602e1..a359f14 100644
--- a/gcc/ada/s-gearop.adb
+++ b/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,13 +81,14 @@ 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
 
       if Index < First
-           or else First > Integer'Last - Order + 1
-           or else Index > First + (Order - 1)
+        or else First > Integer'Last - Order + 1
+        or else Index > First + (Order - 1)
       then
          raise Constraint_Error;
       end if;
@@ -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.
 
-               for J in M'First (1) .. Row - 1 loop
-                  Sub_Row (N, J, Row, (M (J, Col) / M (Row, Col)));
-                  Sub_Row (M, J, Row, (M (J, Col) / M (Row, Col)));
-               end loop;
+               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..
+
+                  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:
@@ -168,7 +188,7 @@ package body System.Generic_Array_Operations is
       --  a reciprocal, we divide.
 
       procedure Sub_Row
-        (M : in out Matrix;
+        (M      : in out Matrix;
          Target : Integer;
          Source : Integer;
          Factor : Scalar);
@@ -196,7 +216,7 @@ package body System.Generic_Array_Operations is
          Target : Integer;
          Source : Integer;
          Factor : Scalar)
-         is
+      is
       begin
          for J in M'Range (2) loop
             M (Target, J) := M (Target, J) - Factor * M (Source, J);
@@ -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;
 
@@ -336,7 +359,8 @@ package body System.Generic_Array_Operations is
    -------------
 
    function L2_Norm (X : X_Vector) return Result_Real'Base is
-      Sum    : Result_Real'Base := 0.0;
+      Sum : Result_Real'Base := 0.0;
+
    begin
       for J in X'Range loop
          Sum := Sum + Result_Real'Base (abs X (J))**2;
@@ -383,17 +407,17 @@ 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";
+           "matrices are of different dimension in elementwise operation";
       end if;
 
       for J in R'Range (1) loop
@@ -423,10 +447,11 @@ 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";
+           "matrices are of different dimension in elementwise operation";
       end if;
 
       for J in R'Range (1) loop
@@ -456,7 +481,7 @@ package body System.Generic_Array_Operations is
    begin
       if Left'Length /= Right'Length then
          raise Constraint_Error with
-            "vectors are of different length in elementwise operation";
+           "vectors are of different length in elementwise operation";
       end if;
 
       for J in R'Range loop
@@ -480,7 +505,7 @@ package body System.Generic_Array_Operations is
    begin
       if X'Length /= Y'Length then
          raise Constraint_Error with
-            "vectors are of different length in elementwise operation";
+           "vectors are of different length in elementwise operation";
       end if;
 
       for J in R'Range loop
@@ -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;
@@ -629,7 +655,7 @@ package body System.Generic_Array_Operations is
    begin
       if Left'Length (2) /= Right'Length (1) then
          raise Constraint_Error with
-            "incompatible dimensions in matrix multiplication";
+           "incompatible dimensions in matrix multiplication";
       end if;
 
       for J in R'Range (1) loop
@@ -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;
@@ -690,9 +716,9 @@ package body System.Generic_Array_Operations is
    ----------------------------
 
    function Matrix_Matrix_Solution (A, X : Matrix) return Matrix is
-      N  : constant Natural := A'Length (1);
-      MA : Matrix (A'Range (2), A'Range (2));
-      MB : Matrix (A'Range (2), X'Range (2));
+      N   : constant Natural := A'Length (1);
+      MA  : Matrix (A'Range (2), A'Range (2));
+      MB  : Matrix (A'Range (2), X'Range (2));
       Det : Scalar;
 
    begin
@@ -810,7 +836,7 @@ package body System.Generic_Array_Operations is
         or else X'Length (2) /= Y'Length (2)
       then
          raise Constraint_Error with
-            "matrices are of different dimension in update operation";
+           "matrices are of different dimension in update operation";
       end if;
 
       for J in X'Range (1) loop
@@ -829,7 +855,7 @@ package body System.Generic_Array_Operations is
    begin
       if X'Length /= Y'Length then
          raise Constraint_Error with
-            "vectors are of different length in update operation";
+           "vectors are of different length in update operation";
       end if;
 
       for J in X'Range loop
@@ -888,7 +914,7 @@ package body System.Generic_Array_Operations is
    begin
       if Left'Length /= Right'Length (2) then
          raise Constraint_Error with
-            "incompatible dimensions in vector-matrix multiplication";
+           "incompatible dimensions in vector-matrix multiplication";
       end if;
 
       for J in Right'Range (2) loop
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index befd210..489f724 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/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
diff --git a/gcc/ada/warnsw.adb b/gcc/ada/warnsw.adb
index 711b943..78b36eb 100644
--- a/gcc/ada/warnsw.adb
+++ b/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;
diff --git a/gcc/ada/warnsw.ads b/gcc/ada/warnsw.ads
index f1449f8..9fd998b 100644
--- a/gcc/ada/warnsw.ads
+++ b/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;