Skip to content

Commit 08becd8

Browse files
committed
add ggev tests
1 parent e84f91a commit 08becd8

File tree

1 file changed

+35
-4
lines changed

1 file changed

+35
-4
lines changed

test/linalg/test_linalg_eigenvalues.fypp

Lines changed: 35 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
module test_linalg_eigenvalues
44
use stdlib_linalg_constants
55
use stdlib_linalg_state
6-
use stdlib_linalg, only: eig, eigh, eigvals, eigvalsh, diag
6+
use stdlib_linalg, only: eig, eigh, eigvals, eigvalsh, diag, eye
77
use testdrive, only: error_type, check, new_unittest, unittest_type
88

99
implicit none (type,external)
@@ -33,7 +33,8 @@ module test_linalg_eigenvalues
3333
#:for ck,ct,ci in CMPLX_KINDS_TYPES
3434
#:if ck!="xdp"
3535
tests = [tests,new_unittest("test_eig_complex_${ci}$",test_eig_complex_${ci}$), &
36-
new_unittest("test_eig_generalized_complex_${ci}$",test_eigvals_generalized_complex_${ci}$)]
36+
new_unittest("test_eig_generalized_complex_${ci}$",test_eigvals_generalized_complex_${ci}$), &
37+
new_unittest("test_eig_issue_927_${ci}$",test_issue_927_${ci}$)]
3738
#:endif
3839
#: endfor
3940

@@ -309,8 +310,6 @@ module test_linalg_eigenvalues
309310

310311
lambda = eigvals(A, B, err=state)
311312

312-
print *, 'lambda = ',lambda
313-
314313
!> Expected eigenvalues
315314
lres(1) = czero
316315
lres(2) = 2*cone
@@ -324,10 +323,42 @@ module test_linalg_eigenvalues
324323

325324
end subroutine test_eigvals_generalized_complex_${ci}$
326325

326+
! Generalized eigenvalues should not crash
327+
subroutine test_issue_927_${ci}$(error)
328+
type(error_type), allocatable, intent(out) :: error
329+
330+
${ct}$, dimension(3,3) :: A_Z,S_Z,vecs_r
331+
${ct}$,dimension(3) :: eigs
332+
real(${ck}$), dimension(3,3) :: A_D,S_D
333+
type(linalg_state_type) :: state
334+
integer :: i
335+
336+
! Set matrix
337+
A_Z = reshape( [ [1, 6, 3], &
338+
[9, 2, 1], &
339+
[8, 3, 4] ], [3,3] )
340+
341+
S_Z = eye(3, mold=0.0_${ck}$)
342+
343+
A_D = real(A_Z)
344+
S_D = real(S_Z)
345+
346+
call eig(A_D,S_D,eigs,right=vecs_r,err=state)
347+
call check(error, state%ok(), 'test issue 927 (${ct}$): '//state%print())
348+
if (allocated(error)) return
349+
350+
call eig(A_Z,S_Z,eigs,right=vecs_r,err=state) !Fails
351+
call check(error, state%ok(), 'test issue 927 (${ct}$): '//state%print())
352+
if (allocated(error)) return
353+
354+
end subroutine test_issue_927_${ci}$
355+
327356
#:endif
328357
#:endfor
329358

330359

360+
361+
331362
end module test_linalg_eigenvalues
332363

333364
program test_eigenvalues

0 commit comments

Comments
 (0)