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.

Tested on x86-64/Linux, applied on all active branches.


2024-12-12  Eric Botcazou  <ebotca...@adacore.com>

        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.


2024-12-12  Eric Botcazou  <ebotca...@adacore.com>

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

-- 
Eric Botcazou
diff --git a/gcc/ada/libgnat/a-ngrear.adb b/gcc/ada/libgnat/a-ngrear.adb
index e70617f2096..6778a56e45c 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
-- { 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;

Reply via email to