[multiple changes]

2016-04-27  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.ads, sem_util.adb (Is_Null_Record_Type): New predicate
	to determine whether a record type is a null record.
	* sem_ch3.adb (Analyze_Object_Declaration): If the type is a
	null record and there is no expression in the declaration,
	no predicate check applies to the object.

2016-04-27  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch7.adb (Analyze_Package_Body_Helper): The body of an
	instantiated package should not cause freezing of previous contracts.

2016-04-27  Ed Schonberg  <schonberg@adacore.com>

	* sem_dim.adb (Analyze_Dimension): Handle subtype declarations
	that do not come from source.
	(Analyze_Dimension_Subtype_Declaration): Allow confirming
	dimensions on subtype entity, either inherited from base type
	or provided by aspect specification.

2016-04-27  Ed Schonberg  <schonberg@adacore.com>

	* s-gearop.ads (Matrix_Vector_Solution, Matrix_Matrix_Solution):
	Add scalar formal object Zero, to allow detection and report
	when the matrix is singular.
	* s-gearop.adb (Matrix_Vector_Solution, Matrix_Matrix_Solution):
	Raise Constraint_Error if the Forward_Eliminate pass has
	determined that determinant is Zero.o
	* s-ngrear.adb (Solve): Add actual for Zero in corresponding
	instantiations.
	* s-ngcoar.adb (Solve): Ditto.

From-SVN: r235499

10 files changed, 134 insertions, 52 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 39ec57e..0aee0a8 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,36 @@
+2016-04-27  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_util.ads, sem_util.adb (Is_Null_Record_Type): New predicate
+	to determine whether a record type is a null record.
+	* sem_ch3.adb (Analyze_Object_Declaration): If the type is a
+	null record and there is no expression in the declaration,
+	no predicate check applies to the object.
+
+2016-04-27  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_ch7.adb (Analyze_Package_Body_Helper): The body of an
+	instantiated package should not cause freezing of previous contracts.
+
+2016-04-27  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_dim.adb (Analyze_Dimension): Handle subtype declarations
+	that do not come from source.
+	(Analyze_Dimension_Subtype_Declaration): Allow confirming
+	dimensions on subtype entity, either inherited from base type
+	or provided by aspect specification.
+
+2016-04-27  Ed Schonberg  <schonberg@adacore.com>
+
+	* s-gearop.ads (Matrix_Vector_Solution, Matrix_Matrix_Solution):
+	Add scalar formal object Zero, to allow detection and report
+	when the matrix is singular.
+	* s-gearop.adb (Matrix_Vector_Solution, Matrix_Matrix_Solution):
+	Raise Constraint_Error if the Forward_Eliminate pass has
+	determined that determinant is Zero.o
+	* s-ngrear.adb (Solve): Add actual for Zero in corresponding
+	instantiations.
+	* s-ngcoar.adb (Solve): Ditto.
+
 2016-04-27  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* sem_ch3.adb: Minor reformatting.
diff --git a/gcc/ada/a-ngcoar.adb b/gcc/ada/a-ngcoar.adb
index ca0c58c..e9b2465 100644
--- a/gcc/ada/a-ngcoar.adb
+++ b/gcc/ada/a-ngcoar.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---            Copyright (C) 2006-2012, Free Software Foundation, Inc.       --
+--            Copyright (C) 2006-2016, 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- --
@@ -30,7 +30,6 @@
 ------------------------------------------------------------------------------
 
 with System.Generic_Array_Operations; use System.Generic_Array_Operations;
-with Ada.Numerics; use Ada.Numerics;
 
 package body Ada.Numerics.Generic_Complex_Arrays is
 
@@ -694,11 +693,11 @@ package body Ada.Numerics.Generic_Complex_Arrays is
       -- Solve --
       -----------
 
-      function Solve is
-         new Matrix_Vector_Solution (Complex, Complex_Vector, Complex_Matrix);
+      function Solve is new Matrix_Vector_Solution
+        (Complex, (0.0, 0.0), Complex_Vector, Complex_Matrix);
 
-      function Solve is
-         new Matrix_Matrix_Solution (Complex, Complex_Matrix);
+      function Solve is new Matrix_Matrix_Solution
+        (Complex, (0.0, 0.0), Complex_Matrix);
 
       -----------------
       -- Unit_Matrix --
diff --git a/gcc/ada/a-ngrear.adb b/gcc/ada/a-ngrear.adb
index 68d5365..c3b954a 100644
--- a/gcc/ada/a-ngrear.adb
+++ b/gcc/ada/a-ngrear.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2006-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 2006-2016, 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- --
@@ -337,10 +337,11 @@ package body Ada.Numerics.Generic_Real_Arrays is
            Result_Matrix => Real_Matrix,
            Operation     => "abs");
 
-      function Solve is
-         new Matrix_Vector_Solution (Real'Base, Real_Vector, Real_Matrix);
+      function Solve is new
+        Matrix_Vector_Solution (Real'Base, 0.0, Real_Vector, Real_Matrix);
 
-      function Solve is new Matrix_Matrix_Solution (Real'Base, Real_Matrix);
+      function Solve is new
+        Matrix_Matrix_Solution (Real'Base, 0.0, Real_Matrix);
 
       function Unit_Matrix is new
         Generic_Array_Operations.Unit_Matrix
diff --git a/gcc/ada/s-gearop.adb b/gcc/ada/s-gearop.adb
index f84280e..b6d6f22 100644
--- a/gcc/ada/s-gearop.adb
+++ b/gcc/ada/s-gearop.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---         Copyright (C) 2006-2012, Free Software Foundation, Inc.          --
+--         Copyright (C) 2006-2016, 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- --
@@ -30,9 +30,7 @@
 ------------------------------------------------------------------------------
 
 with Ada.Numerics; use Ada.Numerics;
-
 package body System.Generic_Array_Operations is
-
    function Check_Unit_Last
      (Index : Integer;
       Order : Positive;
@@ -696,6 +694,11 @@ package body System.Generic_Array_Operations is
       end loop;
 
       Forward_Eliminate (MA, MX, Det);
+
+      if Det = Zero then
+         raise Constraint_Error with "matrix is singular";
+      end if;
+
       Back_Substitute (MA, MX);
 
       for J in 0 .. R'Length - 1 loop
@@ -735,6 +738,11 @@ package body System.Generic_Array_Operations is
       end loop;
 
       Forward_Eliminate (MA, MB, Det);
+
+      if Det = Zero then
+         raise Constraint_Error with "matrix is singular";
+      end if;
+
       Back_Substitute (MA, MB);
 
       return MB;
diff --git a/gcc/ada/s-gearop.ads b/gcc/ada/s-gearop.ads
index f401da2..7e252ee 100644
--- a/gcc/ada/s-gearop.ads
+++ b/gcc/ada/s-gearop.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2006-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2006-2016, 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- --
@@ -396,6 +396,7 @@ pragma Pure (Generic_Array_Operations);
 
    generic
       type Scalar is private;
+      Zero : Scalar;
       type Vector is array (Integer range <>) of Scalar;
       type Matrix is array (Integer range <>, Integer range <>) of Scalar;
       with procedure Back_Substitute (M, N : in out Matrix) is <>;
@@ -411,6 +412,7 @@ pragma Pure (Generic_Array_Operations);
 
    generic
       type Scalar is private;
+      Zero : Scalar;
       type Matrix is array (Integer range <>, Integer range <>) of Scalar;
       with procedure Back_Substitute (M, N : in out Matrix) is <>;
       with procedure Forward_Eliminate
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index cde4d1a..c9aa9d6 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -3835,8 +3835,16 @@ package body Sem_Ch3 is
             Check_Expression_Against_Static_Predicate (E, T);
          end if;
 
-         Insert_After (N,
-           Make_Predicate_Check (T, New_Occurrence_Of (Id, Loc)));
+         --  If the type is a null record and there is no explicit initial
+         --  expression, no predicate check applies.
+
+         if No (E) and then Is_Null_Record_Type (T) then
+            null;
+
+         else
+            Insert_After (N,
+              Make_Predicate_Check (T, New_Occurrence_Of (Id, Loc)));
+         end if;
       end if;
 
       --  Case of unconstrained type
@@ -13039,7 +13047,7 @@ package body Sem_Ch3 is
       procedure Fixup_Bad_Constraint;
       --  Called after finding a bad constraint, and after having posted an
       --  appropriate error message. The goal is to leave type Def_Id in as
-      --  reasonable state as possiblet.
+      --  reasonable state as possible.
 
       --------------------------
       -- Fixup_Bad_Constraint --
@@ -13112,7 +13120,7 @@ package body Sem_Ch3 is
         and then Nkind (Parent (S)) = N_Subtype_Declaration
         and then not Is_Itype (Def_Id)
       then
-         --  A little sanity check, emit an error message if the type has
+         --  A little sanity check: emit an error message if the type has
          --  discriminants to begin with. Type T may be a regular incomplete
          --  type or imported via a limited with clause.
 
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index dc742de..1a8786d 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -544,35 +544,6 @@ package body Sem_Ch7 is
    --  Start of processing for Analyze_Package_Body_Helper
 
    begin
-      --  A [generic] package body "freezes" the contract of the nearest
-      --  enclosing package body and all other contracts encountered in the
-      --  same declarative part up to and excluding the package body:
-
-      --    package body Nearest_Enclosing_Package
-      --      with Refined_State => (State => Constit)
-      --    is
-      --       Constit : ...;
-
-      --       package body Freezes_Enclosing_Package_Body
-      --         with Refined_State => (State_2 => Constit_2)
-      --       is
-      --          Constit_2 : ...;
-
-      --          procedure Proc
-      --            with Refined_Depends => (Input => (Constit, Constit_2)) ...
-
-      --  This ensures that any annotations referenced by the contract of a
-      --  [generic] subprogram body declared within the current package body
-      --  are available. This form of "freezing" is decoupled from the usual
-      --  Freeze_xxx mechanism because it must also work in the context of
-      --  generics where normal freezing is disabled.
-
-      --  Only bodies coming from source should cause this type of "freezing"
-
-      if Comes_From_Source (N) then
-         Analyze_Previous_Contracts (N);
-      end if;
-
       --  Find corresponding package specification, and establish the current
       --  scope. The visible defining entity for the package is the defining
       --  occurrence in the spec. On exit from the package body, all body
@@ -628,6 +599,42 @@ package body Sem_Ch7 is
          end if;
       end if;
 
+      --  A [generic] package body "freezes" the contract of the nearest
+      --  enclosing package body and all other contracts encountered in the
+      --  same declarative part up to and excluding the package body:
+
+      --    package body Nearest_Enclosing_Package
+      --      with Refined_State => (State => Constit)
+      --    is
+      --       Constit : ...;
+
+      --       package body Freezes_Enclosing_Package_Body
+      --         with Refined_State => (State_2 => Constit_2)
+      --       is
+      --          Constit_2 : ...;
+
+      --          procedure Proc
+      --            with Refined_Depends => (Input => (Constit, Constit_2)) ...
+
+      --  This ensures that any annotations referenced by the contract of a
+      --  [generic] subprogram body declared within the current package body
+      --  are available. This form of "freezing" is decoupled from the usual
+      --  Freeze_xxx mechanism because it must also work in the context of
+      --  generics where normal freezing is disabled.
+
+      --  Only bodies coming from source should cause this type of "freezing".
+      --  Instantiated generic bodies are excluded because their processing is
+      --  performed in a separate compilation pass which lacks enough semantic
+      --  information with respect to contract analysis. It is safe to suppress
+      --  the "freezing" of contracts in this case because this action already
+      --  took place at the end of the enclosing declarative part.
+
+      if Comes_From_Source (N)
+        and then not Is_Generic_Instance (Spec_Id)
+      then
+         Analyze_Previous_Contracts (N);
+      end if;
+
       --  A package body is Ghost when the corresponding spec is Ghost. Set
       --  the mode now to ensure that any nodes generated during analysis and
       --  expansion are properly flagged as ignored Ghost.
diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb
index c7282b1..cabb013 100644
--- a/gcc/ada/sem_dim.adb
+++ b/gcc/ada/sem_dim.adb
@@ -1120,9 +1120,15 @@ package body Sem_Dim is
    procedure Analyze_Dimension (N : Node_Id) is
    begin
       --  Aspect is an Ada 2012 feature. Note that there is no need to check
-      --  dimensions for nodes that don't come from source.
+      --  dimensions for nodes that don't come from source, except for subtype
+      --  declarations where the dimensions are inherited from the base type.
 
-      if Ada_Version < Ada_2012 or else not Comes_From_Source (N) then
+      if Ada_Version < Ada_2012 then
+         return;
+
+      elsif not Comes_From_Source (N)
+        and then Nkind (N) /= N_Subtype_Declaration
+      then
          return;
       end if;
 
@@ -2232,10 +2238,10 @@ package body Sem_Dim is
 
          if Exists (Dims_Of_Etyp) then
 
-            --  If subtype already has a dimension (from Aspect_Dimension),
-            --  it cannot inherit a dimension from its subtype.
+            --  If subtype already has a dimension (from Aspect_Dimension), it
+            --  cannot inherit different dimensions from its subtype.
 
-            if Exists (Dims_Of_Id) then
+            if Exists (Dims_Of_Id) and then Dims_Of_Etyp /= Dims_Of_Id then
                Error_Msg_NE
                  ("subtype& already " & Dimensions_Msg_Of (Id, True), N, Id);
             else
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 7f99291..e1b1b50 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -13111,6 +13111,20 @@ package body Sem_Util is
    end Is_Nontrivial_Default_Init_Cond_Procedure;
 
    -------------------------
+   -- Is_Null_Record_Type --
+   -------------------------
+
+   function Is_Null_Record_Type (T : Entity_Id) return Boolean is
+      Decl : constant Node_Id := Parent (T);
+   begin
+      return Nkind (Decl) = N_Full_Type_Declaration
+        and then Nkind (Type_Definition (Decl)) = N_Record_Definition
+        and then
+          (No (Component_List (Type_Definition (Decl)))
+            or else Null_Present (Component_List (Type_Definition (Decl))));
+   end Is_Null_Record_Type;
+
+   -------------------------
    -- Is_Object_Reference --
    -------------------------
 
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 0845bf7..fb049ef 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1481,6 +1481,10 @@ package Sem_Util is
    --  assertion expression of pragma Default_Initial_Condition and if it does,
    --  the encapsulated expression is nontrivial.
 
+   function Is_Null_Record_Type (T : Entity_Id) return Boolean;
+   --  Determine whether T is declared with a null record definition or a
+   --  null component list.
+
    function Is_Object_Reference (N : Node_Id) return Boolean;
    --  Determines if the tree referenced by N represents an object. Both
    --  variable and constant objects return True (compare Is_Variable).