procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix precondition failure with Ada.Numerics.Generic_Real_Arrays.Eigenvalues

Browse source 
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.
This commit is contained in:
Eric Botcazou 2024-12-12 16:25:09 +01:00
parent c94ac10ffc
commit b563a3a00d
2 changed files with 30 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
gcc/ada/libgnat/a-ngrear.adb
View file

@ -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

16
gcc/testsuite/gnat.dg/matrix1.adb Normal file
View file

@ -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;