diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2024-12-12 16:25:09 +0100 |
---|---|---|
committer | Eric Botcazou <ebotcazou@adacore.com> | 2024-12-12 16:29:25 +0100 |
commit | b563a3a00db064d4d47fd171379e1d34d0698faa (patch) | |
tree | 11ba59f37138a7099ff19b6ec6e51fdd405d4533 /gcc | |
parent | c94ac10ffc422d4c9a28266b1340382d69518464 (diff) | |
download | gcc-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.adb | 24 | ||||
-rw-r--r-- | 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 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; |