add test program

Author: perazz

test/linalg/test_linalg_lstsq.fypp

@@ -4,7 +4,7 @@
 module test_linalg_least_squares
     use testdrive, only: error_type, check, new_unittest, unittest_type
     use stdlib_linalg_constants
-    use stdlib_linalg, only: lstsq
+    use stdlib_linalg, only: lstsq,solve_lstsq
     use stdlib_linalg_state, only: linalg_state_type
 
     implicit none (type,external)
@@ -20,6 +20,8 @@ module test_linalg_least_squares
         type(unittest_type), allocatable, intent(out) :: tests(:)
 
         allocate(tests(0))
+        
+        tests = [tests,new_unittest("issue_823",test_issue_823)]
 
         #:for rk,rt,ri in REAL_KINDS_TYPES
         #:if rk!="xdp"
@@ -100,6 +102,39 @@ module test_linalg_least_squares
 
     #:endif
     #:endfor
+    
+    ! Test issue #823
+    subroutine test_issue_823(error)
+        type(error_type), allocatable, intent(out) :: error
+        
+        ! Dimension of the problem.
+        integer(ilp), parameter :: n = 42
+        ! Data for the least-squares problem.
+        complex(dp) :: A(n+1, n), b(n+1), x_true(n), x_lstsq(n+1)
+        ! Internal variables.
+        real(dp), allocatable :: tmp(:, :, :), tmp_vec(:, :)
+        ! Error handler
+        type(linalg_state_type) :: state
+
+        ! Zero-out data.
+        A = 0.0_dp ; b = 0.0_dp ; x_true = 0.0_dp ; x_lstsq = 0.0_dp
+        allocate(tmp(n+1, n, 2))  ; tmp = 0.0_dp
+        allocate(tmp_vec(n, 2)) ; tmp_vec = 0.0_dp
+
+        ! Generate a random complex least-squares problem of size (n+1, n).
+        call random_number(tmp) ; call random_number(tmp_vec)
+        A = cmplx(tmp(:, :, 1), tmp(:, :, 2), kind=dp)
+        x_true = cmplx(tmp_vec(:, 1), tmp_vec(:, 2), kind=dp)
+        b = matmul(A, x_true)
+
+        ! Solve the lstsq problem.
+        call solve_lstsq(A, b, x_lstsq, err=state)
+          
+        ! Check that no segfault occurred
+        call check(error,state%ok(),'issue 823 returned '//state%print())
+        if (allocated(error)) return
+
+    end subroutine test_issue_823
 
 end module test_linalg_least_squares