[gcc r14-11083] Fix precondition failure with Ada.Numerics.Generic_Real_Arrays.Eigenvalues

[Eric Botcazou via Gcc-cvs]

https://gcc.gnu.org/g:d470d64b398684f510637fe8ada570fff92af841

commit r14-11083-gd470d64b398684f510637fe8ada570fff92af841
Author: Eric Botcazou <ebotca...@adacore.com>
Date:   Thu Dec 12 16:25:09 2024 +0100

    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:
---
 gcc/ada/libgnat/a-ngrear.adb      | 24 ++++++++++++++----------
 gcc/testsuite/gnat.dg/matrix1.adb | 16 ++++++++++++++++
 2 files changed, 30 insertions(+), 10 deletions(-)

diff --git a/gcc/ada/libgnat/a-ngrear.adb b/gcc/ada/libgnat/a-ngrear.adb
index e70617f20965..6778a56e45c6 100644
--- 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
index 000000000000..2a920e27f0ec
--- /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;