Preliminary implementation of default values

src/CMakeLists.txt

@@ -2,6 +2,7 @@ set(SRC
     stdlib_experimental_ascii.f90
     stdlib_experimental_io.f90
     stdlib_experimental_error.f90
+    stdlib_experimental_optval.f90
 )
 
 add_library(fortran_stdlib ${SRC})

src/Makefile.manual

@@ -1,6 +1,7 @@
 SRC = stdlib_experimental_ascii.f90 \
       stdlib_experimental_error.f90 \
       stdlib_experimental_io.f90 \
+      stdlib_experimental_optval.f90 \
       f18estop.f90
 
 LIB = libstdlib.a

src/stdlib_experimental_optval.f90

@@ -0,0 +1,153 @@
+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 iso_fortran_env, only: sp => real32, dp => real64, qp => real128, int8, int16, int32, int64
+  implicit none
+
+
+  private
+  public :: optval
+
+
+  interface optval
+     module procedure optval_sp
+     module procedure optval_dp
+     module procedure optval_qp
+     module procedure optval_int8
+     module procedure optval_int16
+     module procedure optval_int32
+     module procedure optval_int64
+     module procedure optval_logical
+     module procedure optval_character
+     ! TODO: complex kinds
+     ! TODO: differentiate ascii & ucs char kinds
+  end interface optval
+
+
+contains
+
+
+  function optval_sp(x, default) result(y)
+    real(sp), intent(in), optional :: x
+    real(sp), intent(in) :: default
+    real(sp) :: y
+
+    if (present(x)) then
+       y = x
+    else
+       y = default
+    end if
+  end function optval_sp
+
+
+  function optval_dp(x, default) result(y)
+    real(dp), intent(in), optional :: x
+    real(dp), intent(in) :: default
+    real(dp) :: y
+
+    if (present(x)) then
+       y = x
+    else
+       y = default
+    end if
+  end function optval_dp
+
+
+  function optval_qp(x, default) result(y)
+    real(qp), intent(in), optional :: x
+    real(qp), intent(in) :: default
+    real(qp) :: y
+
+    if (present(x)) then
+       y = x
+    else
+       y = default
+    end if
+  end function optval_qp
+
+
+  function optval_int8(x, default) result(y)
+    integer(int8), intent(in), optional :: x
+    integer(int8), intent(in) :: default
+    integer(int8) :: y
+
+    if (present(x)) then
+       y = x
+    else
+       y = default
+    end if
+  end function optval_int8
+
+
+  function optval_int16(x, default) result(y)
+    integer(int16), intent(in), optional :: x
+    integer(int16), intent(in) :: default
+    integer(int16) :: y
+
+    if (present(x)) then
+       y = x
+    else
+       y = default
+    end if
+  end function optval_int16
+
+
+  function optval_int32(x, default) result(y)
+    integer(int32), intent(in), optional :: x
+    integer(int32), intent(in) :: default
+    integer(int32) :: y
+
+    if (present(x)) then
+       y = x
+    else
+       y = default
+    end if
+  end function optval_int32
+
+
+  function optval_int64(x, default) result(y)
+    integer(int64), intent(in), optional :: x
+    integer(int64), intent(in) :: default
+    integer(int64) :: y
+
+    if (present(x)) then
+       y = x
+    else
+       y = default
+    end if
+  end function optval_int64
+
+
+  function optval_logical(x, default) result(y)
+    logical, intent(in), optional :: x
+    logical, intent(in) :: default
+    logical :: y
+
+    if (present(x)) then
+       y = x
+    else
+       y = default
+    end if
+  end function optval_logical
+
+
+  function optval_character(x, default) result(y)
+    character(len=*), intent(in), optional :: x
+    character(len=*), intent(in) :: default
+    character(len=:), allocatable :: y
+
+    if (present(x)) then
+       y = x
+    else
+       y = default
+    end if
+  end function optval_character
+
+end module stdlib_experimental_optval

src/tests/CMakeLists.txt

@@ -1,5 +1,6 @@
 add_subdirectory(ascii)
 add_subdirectory(loadtxt)
+add_subdirectory(optval)
 
 add_executable(test_skip test_skip.f90)
 target_link_libraries(test_skip fortran_stdlib)

src/tests/Makefile.manual

@@ -3,11 +3,14 @@
 all:
 	$(MAKE) -f Makefile.manual --directory=ascii
 	$(MAKE) -f Makefile.manual --directory=loadtxt
+	$(MAKE) -f Makefile.manual --directory=optval
 
 test:
 	$(MAKE) -f Makefile.manual --directory=ascii test
 	$(MAKE) -f Makefile.manual --directory=loadtxt test
+	$(MAKE) -f Makefile.manual --directory=optval test
 
 clean:
 	$(MAKE) -f Makefile.manual --directory=ascii clean
 	$(MAKE) -f Makefile.manual --directory=loadtxt clean
+	$(MAKE) -f Makefile.manual --directory=optval clean

src/tests/optval/CMakeLists.txt

@@ -0,0 +1,4 @@
+add_executable(test_optval test_optval.f90)
+target_link_libraries(test_optval fortran_stdlib)
+
+add_test(NAME OPTVAL COMMAND $<TARGET_FILE:test_optval>)

src/tests/optval/Makefile.manual

@@ -0,0 +1,4 @@
+PROGS_SRC = test_optval.f90
+
+
+include ../Makefile.manual.test.mk

src/tests/optval/test_optval.f90

@@ -0,0 +1,151 @@
+program test_optval
+  use, intrinsic :: iso_fortran_env, only: &
+       sp => real32, dp => real64, qp => real128, &
+       int8, int16, int32, int64
+  use stdlib_experimental_error, only: assert
+  use stdlib_experimental_optval, only: optval
+
+  implicit none
+
+  call test_optval_sp
+  call test_optval_dp
+  call test_optval_qp
+
+  call test_optval_int8
+  call test_optval_int16
+  call test_optval_int32
+  call test_optval_int64
+
+  call test_optval_logical
+
+  call test_optval_character
+
+contains
+
+
+  subroutine test_optval_sp
+    print *, "test_optval_sp"
+    call assert(foo_sp(1.0_sp) == 1.0_sp)
+    call assert(foo_sp() == 2.0_sp)
+  end subroutine test_optval_sp
+
+
+  function foo_sp(x) result(z)
+    real(sp), intent(in), optional :: x
+    real(sp) :: z
+    z = optval(x, 2.0_sp)
+  endfunction foo_sp
+
+
+  subroutine test_optval_dp
+    print *, "test_optval_dp"
+    call assert(foo_dp(1.0_dp) == 1.0_dp)
+    call assert(foo_dp() == 2.0_dp)
+  end subroutine test_optval_dp
+
+
+  function foo_dp(x) result(z)
+    real(dp), intent(in), optional :: x
+    real(dp) :: z
+    z = optval(x, 2.0_dp)
+  endfunction foo_dp
+
+
+  subroutine test_optval_qp
+    print *, "test_optval_qp"
+    call assert(foo_qp(1.0_qp) == 1.0_qp)
+    call assert(foo_qp() == 2.0_qp)
+  end subroutine test_optval_qp
+
+
+  function foo_qp(x) result(z)
+    real(qp), intent(in), optional :: x
+    real(qp) :: z
+    z = optval(x, 2.0_qp)
+  endfunction foo_qp
+
+
+  subroutine test_optval_int8
+    print *, "test_optval_int8"
+    call assert(foo_int8(1_int8) == 1_int8)
+    call assert(foo_int8() == 2_int8)
+  end subroutine test_optval_int8
+
+
+  function foo_int8(x) result(z)
+    integer(int8), intent(in), optional :: x
+    integer(int8) :: z
+    z = optval(x, 2_int8)
+  endfunction foo_int8
+
+
+  subroutine test_optval_int16
+    print *, "test_optval_int16"
+    call assert(foo_int16(1_int16) == 1_int16)
+    call assert(foo_int16() == 2_int16)
+  end subroutine test_optval_int16
+
+
+  function foo_int16(x) result(z)
+    integer(int16), intent(in), optional :: x
+    integer(int16) :: z
+    z = optval(x, 2_int16)
+  endfunction foo_int16
+
+
+  subroutine test_optval_int32
+    print *, "test_optval_int32"
+    call assert(foo_int32(1_int32) == 1_int32)
+    call assert(foo_int32() == 2_int32)
+  end subroutine test_optval_int32
+
+
+  function foo_int32(x) result(z)
+    integer(int32), intent(in), optional :: x
+    integer(int32) :: z
+    z = optval(x, 2_int32)
+  endfunction foo_int32
+
+
+  subroutine test_optval_int64
+    print *, "test_optval_int64"
+    call assert(foo_int64(1_int64) == 1_int64)
+    call assert(foo_int64() == 2_int64)
+  end subroutine test_optval_int64
+
+
+  function foo_int64(x) result(z)
+    integer(int64), intent(in), optional :: x
+    integer(int64) :: z
+    z = optval(x, 2_int64)
+  endfunction foo_int64
+
+
+  subroutine test_optval_logical
+    print *, "test_optval_logical"
+    call assert(foo_logical(.true.))
+    call assert(.not.foo_logical())
+  end subroutine test_optval_logical
+
+
+  function foo_logical(x) result(z)
+    logical, intent(in), optional :: x
+    logical :: z
+    z = optval(x, .false.)
+  endfunction foo_logical
+
+
+  subroutine test_optval_character
+    print *, "test_optval_character"
+    call assert(foo_character("x") == "x")
+    call assert(foo_character() == "y")
+  end subroutine test_optval_character
+
+
+  function foo_character(x) result(z)
+    character(len=*), intent(in), optional :: x
+    character(len=:), allocatable :: z
+    z = optval(x, "y")
+  endfunction foo_character
+
+end program test_optval