Merge pull request #96 from nshaffer/dev-optval

Make optval pure or pure elemental where possible

Author: certik

src/stdlib_experimental_optval.f90

@@ -34,7 +34,7 @@ module stdlib_experimental_optval
 contains
 
 
-  pure function optval_sp(x, default) result(y)
+  pure elemental function optval_sp(x, default) result(y)
     real(sp), intent(in), optional :: x
     real(sp), intent(in) :: default
     real(sp) :: y
@@ -47,7 +47,7 @@ pure function optval_sp(x, default) result(y)
   end function optval_sp
 
 
-  pure function optval_dp(x, default) result(y)
+  pure elemental function optval_dp(x, default) result(y)
     real(dp), intent(in), optional :: x
     real(dp), intent(in) :: default
     real(dp) :: y
@@ -60,7 +60,7 @@ pure function optval_dp(x, default) result(y)
   end function optval_dp
 
 
-  pure function optval_qp(x, default) result(y)
+  pure elemental function optval_qp(x, default) result(y)
     real(qp), intent(in), optional :: x
     real(qp), intent(in) :: default
     real(qp) :: y
@@ -73,7 +73,7 @@ pure function optval_qp(x, default) result(y)
   end function optval_qp
 
 
-  pure function optval_int8(x, default) result(y)
+  pure elemental function optval_int8(x, default) result(y)
     integer(int8), intent(in), optional :: x
     integer(int8), intent(in) :: default
     integer(int8) :: y
@@ -86,7 +86,7 @@ pure function optval_int8(x, default) result(y)
   end function optval_int8
 
 
-  pure function optval_int16(x, default) result(y)
+  pure elemental function optval_int16(x, default) result(y)
     integer(int16), intent(in), optional :: x
     integer(int16), intent(in) :: default
     integer(int16) :: y
@@ -99,7 +99,7 @@ pure function optval_int16(x, default) result(y)
   end function optval_int16
 
 
-  pure function optval_int32(x, default) result(y)
+  pure elemental function optval_int32(x, default) result(y)
     integer(int32), intent(in), optional :: x
     integer(int32), intent(in) :: default
     integer(int32) :: y
@@ -112,7 +112,7 @@ pure function optval_int32(x, default) result(y)
   end function optval_int32
 
 
-  pure function optval_int64(x, default) result(y)
+  pure elemental function optval_int64(x, default) result(y)
     integer(int64), intent(in), optional :: x
     integer(int64), intent(in) :: default
     integer(int64) :: y
@@ -125,7 +125,7 @@ pure function optval_int64(x, default) result(y)
   end function optval_int64
 
 
-  pure function optval_logical(x, default) result(y)
+  pure elemental function optval_logical(x, default) result(y)
     logical, intent(in), optional :: x
     logical, intent(in) :: default
     logical :: y

src/tests/optval/test_optval.f90

@@ -20,16 +20,25 @@ program test_optval
 
   call test_optval_character
 
+
+  call test_optval_sp_arr
+  call test_optval_dp_arr
+  call test_optval_qp_arr
+
+  call test_optval_int8_arr
+  call test_optval_int16_arr
+  call test_optval_int32_arr
+  call test_optval_int64_arr
+
 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
@@ -43,7 +52,7 @@ subroutine test_optval_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
@@ -57,95 +66,207 @@ subroutine test_optval_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
-  
+
+
+  subroutine test_optval_sp_arr
+    print *, "test_optval_sp_arr"
+    call assert(all(foo_sp_arr([1.0_sp, -1.0_sp]) == [1.0_sp, -1.0_sp]))
+    call assert(all(foo_sp_arr() == [2.0_sp, -2.0_sp]))
+  end subroutine test_optval_sp_arr
+
+
+  function foo_sp_arr(x) result(z)
+    real(sp), dimension(2), intent(in), optional :: x
+    real(sp), dimension(2) :: z
+    z = optval(x, [2.0_sp, -2.0_sp])
+  end function foo_sp_arr
+
+
+  subroutine test_optval_dp_arr
+    print *, "test_optval_dp_arr"
+    call assert(all(foo_dp_arr([1.0_dp, -1.0_dp]) == [1.0_dp, -1.0_dp]))
+    call assert(all(foo_dp_arr() == [2.0_dp, -2.0_dp]))
+  end subroutine test_optval_dp_arr
+
+
+  function foo_dp_arr(x) result(z)
+    real(dp), dimension(2), intent(in), optional :: x
+    real(dp), dimension(2) :: z
+    z = optval(x, [2.0_dp, -2.0_dp])
+  end function foo_dp_arr
+
+
+  subroutine test_optval_qp_arr
+    print *, "test_optval_qp_arr"
+    call assert(all(foo_qp_arr([1.0_qp, -1.0_qp]) == [1.0_qp, -1.0_qp]))
+    call assert(all(foo_qp_arr() == [2.0_qp, -2.0_qp]))
+  end subroutine test_optval_qp_arr
+
+
+  function foo_qp_arr(x) result(z)
+    real(qp), dimension(2), intent(in), optional :: x
+    real(qp), dimension(2) :: z
+    z = optval(x, [2.0_qp, -2.0_qp])
+  end function foo_qp_arr
+
+
+  subroutine test_optval_int8_arr
+    print *, "test_optval_int8_arr"
+    call assert(all(foo_int8_arr([1_int8, -1_int8]) == [1_int8, -1_int8]))
+    call assert(all(foo_int8_arr() == [2_int8, -2_int8]))
+  end subroutine test_optval_int8_arr
+
+
+  function foo_int8_arr(x) result(z)
+    integer(int8), dimension(2), intent(in), optional :: x
+    integer(int8), dimension(2) :: z
+    z = optval(x, [2_int8, -2_int8])
+  end function foo_int8_arr
+
+
+  subroutine test_optval_int16_arr
+    print *, "test_optval_int16_arr"
+    call assert(all(foo_int16_arr([1_int16, -1_int16]) == [1_int16, -1_int16]))
+    call assert(all(foo_int16_arr() == [2_int16, -2_int16]))
+  end subroutine test_optval_int16_arr
+
+
+  function foo_int16_arr(x) result(z)
+    integer(int16), dimension(2), intent(in), optional :: x
+    integer(int16), dimension(2) :: z
+    z = optval(x, [2_int16, -2_int16])
+  end function foo_int16_arr
+
+
+  subroutine test_optval_int32_arr
+    print *, "test_optval_int32_arr"
+    call assert(all(foo_int32_arr([1_int32, -1_int32]) == [1_int32, -1_int32]))
+    call assert(all(foo_int32_arr() == [2_int32, -2_int32]))
+  end subroutine test_optval_int32_arr
+
+
+  function foo_int32_arr(x) result(z)
+    integer(int32), dimension(2), intent(in), optional :: x
+    integer(int32), dimension(2) :: z
+    z = optval(x, [2_int32, -2_int32])
+  end function foo_int32_arr
+
+
+  subroutine test_optval_int64_arr
+    print *, "test_optval_int64_arr"
+    call assert(all(foo_int64_arr([1_int64, -1_int64]) == [1_int64, -1_int64]))
+    call assert(all(foo_int64_arr() == [2_int64, -2_int64]))
+  end subroutine test_optval_int64_arr
+
+
+  function foo_int64_arr(x) result(z)
+    integer(int64), dimension(2), intent(in), optional :: x
+    integer(int64), dimension(2) :: z
+    z = optval(x, [2_int64, -2_int64])
+  end function foo_int64_arr
+
+
+  subroutine test_optval_logical_arr
+    print *, "test_optval_logical_arr"
+    call assert(all(foo_logical_arr()))
+    call assert(all(.not.foo_logical_arr()))
+  end subroutine test_optval_logical_arr
+
+
+  function foo_logical_arr(x) result(z)
+    logical, dimension(2), intent(in), optional :: x
+    logical, dimension(2) :: z
+    z = optval(x, [.false., .false.])
+  end function foo_logical_arr
+
 end program test_optval