@@ -21,11 +21,11 @@ module test_linalg_least_squares
21
21
22
22
allocate(tests(0))
23
23
24
- tests = [ tests,new_unittest("issue_823",test_issue_823)]
24
+ call add_test( tests,new_unittest("issue_823",test_issue_823))
25
25
26
26
#: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}$))
29
29
#:endfor
30
30
31
31
end subroutine test_least_squares
@@ -139,6 +139,27 @@ module test_linalg_least_squares
139
139
140
140
end subroutine test_issue_823
141
141
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
+
142
163
end module test_linalg_least_squares
143
164
144
165
program test_lstsq
0 commit comments