Fix precondition failure with Ada.Numerics.Generic_Real_Arrays.Eigenvalues

This fixes a precondition failure triggered when the Eigenvalues routine
of Ada.Numerics.Generic_Real_Arrays is instantiated with -gnata, beause
it calls Sort_Eigensystem on an empty vector.

gcc/ada
	PR ada/117996
	* libgnat/a-ngrear.adb (Jacobi): Remove default value for
	Compute_Vectors formal parameter.
	(Sort_Eigensystem): Add Compute_Vectors formal parameter.  Do not
	modify the Vectors if Compute_Vectors is False.
	(Eigensystem): Pass True as Compute_Vectors to Sort_Eigensystem.
	(Eigenvalues): Pass False as Compute_Vectors to Sort_Eigensystem.

gcc/testsuite
	* gnat.dg/matrix1.adb: New test.

diff --git a/gcc/ada/libgnat/a-ngrear.adb b/gcc/ada/libgnat/a-ngrear.adb
index 9cfd95629551fca9c51038fcfcac40594b7caef4..844d6264ee7234c8aa80a99c93039384300b877d 100644 (file)
--- a/gcc/ada/libgnat/a-ngrear.adb
+++ b/gcc/ada/libgnat/a-ngrear.adb
@@ -96,7 +96,7 @@ package body Ada.Numerics.Generic_Real_Arrays is
      (A               : Real_Matrix;
       Values          : out Real_Vector;
       Vectors         : out Real_Matrix;
-      Compute_Vectors : Boolean := True);
+      Compute_Vectors : Boolean);
    --  Perform Jacobi's eigensystem algorithm on real symmetric matrix A
 
    function Length is new Square_Matrix_Length (Real'Base, Real_Matrix);
@@ -107,8 +107,9 @@ package body Ada.Numerics.Generic_Real_Arrays is
    --  Perform a Givens rotation
 
    procedure Sort_Eigensystem
-     (Values  : in out Real_Vector;
-      Vectors : in out Real_Matrix);
+     (Values          : in out Real_Vector;
+      Vectors         : in out Real_Matrix;
+      Compute_Vectors : Boolean);
    --  Sort Values and associated Vectors by decreasing absolute value
 
    procedure Swap (Left, Right : in out Real);
@@ -486,7 +487,7 @@ package body Ada.Numerics.Generic_Real_Arrays is
    is
    begin
       Jacobi (A, Values, Vectors, Compute_Vectors => True);
-      Sort_Eigensystem (Values, Vectors);
+      Sort_Eigensystem (Values, Vectors, Compute_Vectors => True);
    end Eigensystem;
 
    -----------------
@@ -500,7 +501,7 @@ package body Ada.Numerics.Generic_Real_Arrays is
             Vectors : Real_Matrix (1 .. 0, 1 .. 0);
          begin
             Jacobi (A, Values, Vectors, Compute_Vectors => False);
-            Sort_Eigensystem (Values, Vectors);
+            Sort_Eigensystem (Values, Vectors, Compute_Vectors => False);
          end;
       end return;
    end Eigenvalues;
@@ -522,7 +523,7 @@ package body Ada.Numerics.Generic_Real_Arrays is
      (A               : Real_Matrix;
       Values          : out Real_Vector;
       Vectors         : out Real_Matrix;
-      Compute_Vectors : Boolean := True)
+      Compute_Vectors : Boolean)
    is
       --  This subprogram uses Carl Gustav Jacob Jacobi's iterative method
       --  for computing eigenvalues and eigenvectors and is based on
@@ -731,8 +732,9 @@ package body Ada.Numerics.Generic_Real_Arrays is
    ----------------------
 
    procedure Sort_Eigensystem
-     (Values  : in out Real_Vector;
-      Vectors : in out Real_Matrix)
+     (Values          : in out Real_Vector;
+      Vectors         : in out Real_Matrix;
+      Compute_Vectors : Boolean)
    is
       procedure Swap (Left, Right : Integer);
       --  Swap Values (Left) with Values (Right), and also swap the
@@ -748,8 +750,10 @@ package body Ada.Numerics.Generic_Real_Arrays is
       procedure Swap (Left, Right : Integer) is
       begin
          Swap (Values (Left), Values (Right));
-         Swap_Column (Vectors, Left - Values'First + Vectors'First (2),
-                               Right - Values'First + Vectors'First (2));
+         if Compute_Vectors then
+            Swap_Column (Vectors, Left - Values'First + Vectors'First (2),
+                                  Right - Values'First + Vectors'First (2));
+         end if;
       end Swap;
 
    begin

diff --git a/gcc/testsuite/gnat.dg/matrix1.adb b/gcc/testsuite/gnat.dg/matrix1.adb
new file mode 100644 (file)
index 0000000..2a920e2
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/matrix1.adb
@@ -0,0 +1,16 @@
+-- { dg-do run }
+-- { dg-options "-gnata" }
+
+with Ada.Numerics.Generic_Real_Arrays;
+
+procedure Matrix1 is
+
+  package GRA is new Ada.Numerics.Generic_Real_Arrays (real => float);
+  use GRA;
+
+  M : constant Real_Matrix (1..2, 1..2) := ((1.0, 0.0), (0.0, 2.0));
+  E : constant Real_Vector := Eigenvalues (M);
+
+begin
+  null;
+end;