Skip to content

Commit 1ab94a7

Browse files
committed
linalg-mnorm: gcc-15 test fix
1 parent fc9cb6e commit 1ab94a7

File tree

1 file changed

+23
-2
lines changed

1 file changed

+23
-2
lines changed

test/linalg/test_linalg_mnorm.fypp

Lines changed: 23 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -18,9 +18,9 @@ module test_linalg_mnorm
1818
allocate(tests(0))
1919

2020
#:for rk,rt,ri in RC_KINDS_TYPES
21-
tests = [tests,new_unittest("test_matrix_norms_${ri}$",test_matrix_norms_${ri}$)]
21+
call add_test(tests,new_unittest("test_matrix_norms_${ri}$",test_matrix_norms_${ri}$))
2222
#:for rank in range(3, MAXRANK)
23-
tests = [tests,new_unittest("test_mnorm_${ri}$_${rank}$d",test_mnorm_${ri}$_${rank}$d)]
23+
call add_test(tests,new_unittest("test_mnorm_${ri}$_${rank}$d",test_mnorm_${ri}$_${rank}$d))
2424
#:endfor
2525
#:endfor
2626

@@ -135,6 +135,27 @@ module test_linalg_mnorm
135135

136136
#:endfor
137137

138+
! gcc-15 bugfix utility
139+
pure subroutine add_test(tests,new_test)
140+
type(unittest_type), allocatable, intent(inout) :: tests(:)
141+
type(unittest_type), intent(in) :: new_test
142+
143+
integer :: n
144+
type(unittest_type), allocatable :: new_tests(:)
145+
146+
if (allocated(tests)) then
147+
n = size(tests)
148+
else
149+
n = 0
150+
end if
151+
152+
allocate(new_tests(n+1))
153+
if (n>0) new_tests(1:n) = tests(1:n)
154+
new_tests(1+n) = new_test
155+
call move_alloc(from=new_tests,to=tests)
156+
157+
end subroutine add_test
158+
138159
end module test_linalg_mnorm
139160

140161
program test_mnorm

0 commit comments

Comments
 (0)