add linalg_state tests

Author: perazz

test/linalg/test_linalg.fypp

@@ -5,6 +5,7 @@ module test_linalg
     use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test
     use stdlib_kinds, only: sp, dp, xdp, qp, int8, int16, int32, int64
     use stdlib_linalg, only: diag, eye, trace, outer_product, cross_product, kronecker_product
+    use stdlib_linalg_state
 
     implicit none
 
@@ -49,9 +50,9 @@ contains
             new_unittest("trace_int16", test_trace_int16), &
             new_unittest("trace_int32", test_trace_int32), &
             new_unittest("trace_int64", test_trace_int64), &
-  #:for k1, t1 in RCI_KINDS_TYPES	    
+  #:for k1, t1 in RCI_KINDS_TYPES
             new_unittest("kronecker_product_${t1[0]}$${k1}$", test_kronecker_product_${t1[0]}$${k1}$), &
-  #:endfor    
+  #:endfor
             new_unittest("outer_product_rsp", test_outer_product_rsp), &
             new_unittest("outer_product_rdp", test_outer_product_rdp), &
             new_unittest("outer_product_rqp", test_outer_product_rqp), &
@@ -71,7 +72,8 @@ contains
             new_unittest("cross_product_int8", test_cross_product_int8), &
             new_unittest("cross_product_int16", test_cross_product_int16), &
             new_unittest("cross_product_int32", test_cross_product_int32), &
-            new_unittest("cross_product_int64", test_cross_product_int64) &
+            new_unittest("cross_product_int64", test_cross_product_int64), &
+            new_unittest("state_handling", test_state_handling) &
             ]
 
     end subroutine collect_linalg
@@ -560,7 +562,7 @@ contains
 
 
   #:for k1, t1 in RCI_KINDS_TYPES
-    subroutine test_kronecker_product_${t1[0]}$${k1}$(error) 
+    subroutine test_kronecker_product_${t1[0]}$${k1}$(error)
       !> Error handling
       type(error_type), allocatable, intent(out) :: error
       integer, parameter :: m1 = 1, n1 = 2, m2 = 2, n2 = 3
@@ -593,7 +595,7 @@ contains
       ! Expected: C = [1*B, 2*B] = [[1,2,3, 2,4,6], [2,4,6, 4, 8, 12]]
 
     end subroutine test_kronecker_product_${t1[0]}$${k1}$
-  #:endfor    
+  #:endfor
 
     subroutine test_outer_product_rsp(error)
         !> Error handling
@@ -911,6 +913,73 @@ contains
 #:endif
     end subroutine test_cross_product_cqp
 
+    subroutine test_state_handling(error)
+        !> Error handling
+        type(error_type), allocatable, intent(out) :: error
+
+        type(linalg_state) :: state,state_out
+
+        state = linalg_state(LINALG_SUCCESS,' 32-bit real: ',1.0_sp)
+        call check(error, &
+        state%message==' 32-bit real: 1.00000000E+00', &
+        "malformed state message with 32-bit reals.")
+        if (allocated(error)) return
+
+        state = linalg_state(LINALG_SUCCESS,' 64-bit real: ',1.0_dp)
+        call check(error, &
+        state%message==' 64-bit real: 1.0000000000000000E+000', &
+        "malformed state message with 64-bit reals.")
+        if (allocated(error)) return
+
+#:if WITH_QP
+        state = linalg_state(LINALG_SUCCESS,' 128-bit real: ',1.0_qp)
+        call check(error, &
+        state%message==' 128-bit real: 1.00000000000000000000000000000000000E+0000', &
+        "malformed state message with 128-bit reals.")
+        if (allocated(error)) return
+#:endif
+
+        state = linalg_state(LINALG_SUCCESS,' 32-bit complex: ',(1.0_sp,1.0_sp))
+        call check(error, &
+        state%message==' 32-bit complex: (1.00000000E+00,1.00000000E+00)', &
+        "malformed state message with 32-bit complex: "//trim(state%message))
+        if (allocated(error)) return
+
+        state = linalg_state(LINALG_SUCCESS,' 64-bit complex: ',(1.0_dp,1.0_dp))
+        call check(error, &
+        state%message==' 64-bit complex: (1.0000000000000000E+000,1.0000000000000000E+000)', &
+        "malformed state message with 64-bit complex.")
+        if (allocated(error)) return
+
+#:if WITH_QP
+        state = linalg_state(LINALG_SUCCESS,'128-bit complex: ',(1.0_qp,1.0_qp))
+        call check(error, state%message== &
+        '128-bit complex: (1.00000000000000000000000000000000000E+0000,1.00000000000000000000000000000000000E+0000)', &
+        "malformed state message with 128-bit complex.")
+
+#:endif
+
+        state = linalg_state(LINALG_SUCCESS,' 32-bit array: ',v1=[(1.0_sp,0.0_sp),(0.0_sp,1.0_sp)])
+        call check(error, state%message== &
+        ' 32-bit array: [(1.00000000E+00,0.00000000E+00) (0.00000000E+00,1.00000000E+00)]', &
+        "malformed state message with 32-bit real array.")
+        if (allocated(error)) return
+
+        !> State flag with location
+        state = linalg_state('test_formats',LINALG_SUCCESS,' 32-bit real: ',1.0_sp)
+        call check(error, &
+        state%print()=='[test_formats] returned Success!', &
+        "malformed state message with 32-bit real and location.")
+        if (allocated(error)) return
+
+        !> Test error handling procedure
+        call linalg_error_handling(state,state_out)
+        call check(error, state%print()==state_out%print(), &
+        "malformed state message on return from error handling procedure.")
+
+    end subroutine test_state_handling
+
+
     pure recursive function catalan_number(n) result(value)
         integer, intent(in) :: n
         integer :: value