aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2024-12-12 16:25:09 +0100
committerEric Botcazou <ebotcazou@adacore.com>2024-12-12 16:29:25 +0100
commitb563a3a00db064d4d47fd171379e1d34d0698faa (patch)
tree11ba59f37138a7099ff19b6ec6e51fdd405d4533 /gcc
parentc94ac10ffc422d4c9a28266b1340382d69518464 (diff)
downloadgcc-b563a3a00db064d4d47fd171379e1d34d0698faa.zip
gcc-b563a3a00db064d4d47fd171379e1d34d0698faa.tar.gz
gcc-b563a3a00db064d4d47fd171379e1d34d0698faa.tar.bz2
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.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/libgnat/a-ngrear.adb24
-rw-r--r--gcc/testsuite/gnat.dg/matrix1.adb16
2 files changed, 30 insertions, 10 deletions
diff --git a/gcc/ada/libgnat/a-ngrear.adb b/gcc/ada/libgnat/a-ngrear.adb
index e70617f..6778a56 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 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;