Skip to content

Commit fc9cb6e

Browse files
committed
linalg-lstsq: gcc-15 test fix
1 parent 9d657a5 commit fc9cb6e

File tree

1 file changed

+24
-3
lines changed

1 file changed

+24
-3
lines changed

test/linalg/test_linalg_lstsq.fypp

Lines changed: 24 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -21,11 +21,11 @@ module test_linalg_least_squares
2121

2222
allocate(tests(0))
2323

24-
tests = [tests,new_unittest("issue_823",test_issue_823)]
24+
call add_test(tests,new_unittest("issue_823",test_issue_823))
2525

2626
#:for rk,rt,ri in REAL_KINDS_TYPES
27-
tests = [tests,new_unittest("least_squares_${ri}$",test_lstsq_one_${ri}$), &
28-
new_unittest("least_squares_randm_${ri}$",test_lstsq_random_${ri}$)]
27+
call add_test(tests,new_unittest("least_squares_${ri}$",test_lstsq_one_${ri}$))
28+
call add_test(tests,new_unittest("least_squares_randm_${ri}$",test_lstsq_random_${ri}$))
2929
#:endfor
3030

3131
end subroutine test_least_squares
@@ -139,6 +139,27 @@ module test_linalg_least_squares
139139

140140
end subroutine test_issue_823
141141

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

144165
program test_lstsq

0 commit comments

Comments
 (0)