Added support and tests for complex values to optval

Author: fiolj

src/CMakeLists.txt

@@ -3,6 +3,7 @@
 # Create a list of the files to be preprocessed
 set(fppFiles
     stdlib_experimental_io.fypp
+    stdlib_experimental_optval.fypp
     stdlib_experimental_stats.fypp
     stdlib_experimental_stats_mean.fypp
 )
@@ -25,6 +26,7 @@ set(SRC
     stdlib_experimental_error.f90
     stdlib_experimental_kinds.f90
     stdlib_experimental_optval.f90
+    stdlib_experimental_stats.f90
     stdlib_experimental_system.F90
     ${outFiles}
 )

src/stdlib_experimental_optval.f90

@@ -0,0 +1,48 @@
+#:include "common.fypp"
+
+#:set KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + CMPLX_KINDS_TYPES + &
+  & [('l1','logical'), ('C1','character')]
+
+module stdlib_experimental_optval
+  !!
+  !! Provides a generic function `optval`, which can be used to
+  !! conveniently implement fallback values for optional arguments
+  !! to subprograms. If `x` is an `optional` parameter of a
+  !! subprogram, then the expression `optval(x, default)` inside that
+  !! subprogram evaluates to `x` if it is present, otherwise `default`.
+  !!
+  !! It is an error to call `optval` with a single actual argument.
+  !!
+  use stdlib_experimental_kinds, only: sp, dp, qp, int8, int16, int32, int64
+  implicit none
+
+
+  private
+  public :: optval
+
+
+  interface optval
+    #:for k1, t1 in KINDS_TYPES
+      module procedure optval_${t1[0]}$${k1}$
+    #:endfor
+     ! TODO: differentiate ascii & ucs char kinds
+  end interface optval
+
+
+contains
+
+  #:for k1, t1 in KINDS_TYPES
+    pure elemental function optval_${t1[0]}$${k1}$(x, default) result(y)
+    ${t1}$, intent(in), optional :: x
+    ${t1}$, intent(in) :: default
+    ${t1}$ :: y
+
+    if (present(x)) then
+       y = x
+    else
+       y = default
+    end if
+  end function optval_${t1[0]}$${k1}$
+  #:endfor
+
+end module stdlib_experimental_optval

src/stdlib_experimental_optval.fypp

@@ -11,6 +11,8 @@ program test_optval
   call test_optval_dp
   call test_optval_qp
 
+  call test_optval_cdp
+
   call test_optval_int8
   call test_optval_int16
   call test_optval_int32
@@ -60,6 +62,36 @@ function foo_dp(x) result(z)
   endfunction foo_dp
 
 
+  subroutine test_optval_sdp
+    complex(sp) :: z1
+    print *, "test_optval_dp"
+    z1 = cmplx(1.0_sp, 2.0_sp)
+    call assert(foo_sdp(z1) == z1)
+    call assert(foo_sdp() == z1)
+  end subroutine test_optval_sdp
+
+  function foo_sdp(x) result(z)
+    complex(sp), intent(in), optional :: x
+    complex(sp) :: z
+    z = optval(x, cmplx(1.0_sp, 2.0_sp, kind=sp))
+  endfunction foo_sdp
+
+
+  subroutine test_optval_cdp
+    complex(dp) :: z1
+    print *, "test_optval_dp"
+    z1 = cmplx(1.0_dp, 2.0_dp)
+    call assert(foo_cdp(z1) == z1)
+    call assert(foo_cdp() == z1)
+  end subroutine test_optval_cdp
+
+  function foo_cdp(x) result(z)
+    complex(dp), intent(in), optional :: x
+    complex(dp) :: z
+    z = optval(x, cmplx(1.0_dp, 2.0_dp, kind=dp))
+  endfunction foo_cdp
+
+
   subroutine test_optval_qp
     print *, "test_optval_qp"
     call assert(foo_qp(1.0_qp) == 1.0_qp)