|  | 
|  | 1 | +program test_optval | 
|  | 2 | +  use, intrinsic :: iso_fortran_env, only: & | 
|  | 3 | +       sp => real32, dp => real64, qp => real128, & | 
|  | 4 | +       int8, int16, int32, int64 | 
|  | 5 | +  use stdlib_experimental_error, only: assert | 
|  | 6 | +  use stdlib_experimental_optval, only: optval | 
|  | 7 | + | 
|  | 8 | +  implicit none | 
|  | 9 | + | 
|  | 10 | +  call test_optval_sp | 
|  | 11 | +  call test_optval_dp | 
|  | 12 | +  call test_optval_qp | 
|  | 13 | + | 
|  | 14 | +  call test_optval_int8 | 
|  | 15 | +  call test_optval_int16 | 
|  | 16 | +  call test_optval_int32 | 
|  | 17 | +  call test_optval_int64 | 
|  | 18 | + | 
|  | 19 | +  call test_optval_logical | 
|  | 20 | + | 
|  | 21 | +  call test_optval_character | 
|  | 22 | + | 
|  | 23 | +contains | 
|  | 24 | + | 
|  | 25 | +   | 
|  | 26 | +  subroutine test_optval_sp | 
|  | 27 | +    print *, "test_optval_sp" | 
|  | 28 | +    call assert(foo_sp(1.0_sp) == 1.0_sp) | 
|  | 29 | +    call assert(foo_sp() == 2.0_sp) | 
|  | 30 | +  end subroutine test_optval_sp | 
|  | 31 | + | 
|  | 32 | +   | 
|  | 33 | +  function foo_sp(x) result(z) | 
|  | 34 | +    real(sp), intent(in), optional :: x | 
|  | 35 | +    real(sp) :: z | 
|  | 36 | +    z = optval(x, 2.0_sp) | 
|  | 37 | +  endfunction foo_sp | 
|  | 38 | + | 
|  | 39 | + | 
|  | 40 | +  subroutine test_optval_dp | 
|  | 41 | +    print *, "test_optval_dp" | 
|  | 42 | +    call assert(foo_dp(1.0_dp) == 1.0_dp) | 
|  | 43 | +    call assert(foo_dp() == 2.0_dp) | 
|  | 44 | +  end subroutine test_optval_dp | 
|  | 45 | + | 
|  | 46 | +   | 
|  | 47 | +  function foo_dp(x) result(z) | 
|  | 48 | +    real(dp), intent(in), optional :: x | 
|  | 49 | +    real(dp) :: z | 
|  | 50 | +    z = optval(x, 2.0_dp) | 
|  | 51 | +  endfunction foo_dp | 
|  | 52 | + | 
|  | 53 | + | 
|  | 54 | +  subroutine test_optval_qp | 
|  | 55 | +    print *, "test_optval_qp" | 
|  | 56 | +    call assert(foo_qp(1.0_qp) == 1.0_qp) | 
|  | 57 | +    call assert(foo_qp() == 2.0_qp) | 
|  | 58 | +  end subroutine test_optval_qp | 
|  | 59 | + | 
|  | 60 | +   | 
|  | 61 | +  function foo_qp(x) result(z) | 
|  | 62 | +    real(qp), intent(in), optional :: x | 
|  | 63 | +    real(qp) :: z | 
|  | 64 | +    z = optval(x, 2.0_qp) | 
|  | 65 | +  endfunction foo_qp | 
|  | 66 | +   | 
|  | 67 | +   | 
|  | 68 | +  subroutine test_optval_int8 | 
|  | 69 | +    print *, "test_optval_int8" | 
|  | 70 | +    call assert(foo_int8(1_int8) == 1_int8) | 
|  | 71 | +    call assert(foo_int8() == 2_int8) | 
|  | 72 | +  end subroutine test_optval_int8 | 
|  | 73 | + | 
|  | 74 | +   | 
|  | 75 | +  function foo_int8(x) result(z) | 
|  | 76 | +    integer(int8), intent(in), optional :: x | 
|  | 77 | +    integer(int8) :: z | 
|  | 78 | +    z = optval(x, 2_int8) | 
|  | 79 | +  endfunction foo_int8 | 
|  | 80 | +   | 
|  | 81 | + | 
|  | 82 | +  subroutine test_optval_int16 | 
|  | 83 | +    print *, "test_optval_int16" | 
|  | 84 | +    call assert(foo_int16(1_int16) == 1_int16) | 
|  | 85 | +    call assert(foo_int16() == 2_int16) | 
|  | 86 | +  end subroutine test_optval_int16 | 
|  | 87 | + | 
|  | 88 | +   | 
|  | 89 | +  function foo_int16(x) result(z) | 
|  | 90 | +    integer(int16), intent(in), optional :: x | 
|  | 91 | +    integer(int16) :: z | 
|  | 92 | +    z = optval(x, 2_int16) | 
|  | 93 | +  endfunction foo_int16 | 
|  | 94 | + | 
|  | 95 | +   | 
|  | 96 | +  subroutine test_optval_int32 | 
|  | 97 | +    print *, "test_optval_int32" | 
|  | 98 | +    call assert(foo_int32(1_int32) == 1_int32) | 
|  | 99 | +    call assert(foo_int32() == 2_int32) | 
|  | 100 | +  end subroutine test_optval_int32 | 
|  | 101 | + | 
|  | 102 | +   | 
|  | 103 | +  function foo_int32(x) result(z) | 
|  | 104 | +    integer(int32), intent(in), optional :: x | 
|  | 105 | +    integer(int32) :: z | 
|  | 106 | +    z = optval(x, 2_int32) | 
|  | 107 | +  endfunction foo_int32 | 
|  | 108 | + | 
|  | 109 | +   | 
|  | 110 | +  subroutine test_optval_int64 | 
|  | 111 | +    print *, "test_optval_int64" | 
|  | 112 | +    call assert(foo_int64(1_int64) == 1_int64) | 
|  | 113 | +    call assert(foo_int64() == 2_int64) | 
|  | 114 | +  end subroutine test_optval_int64 | 
|  | 115 | + | 
|  | 116 | +   | 
|  | 117 | +  function foo_int64(x) result(z) | 
|  | 118 | +    integer(int64), intent(in), optional :: x | 
|  | 119 | +    integer(int64) :: z | 
|  | 120 | +    z = optval(x, 2_int64) | 
|  | 121 | +  endfunction foo_int64 | 
|  | 122 | +   | 
|  | 123 | + | 
|  | 124 | +  subroutine test_optval_logical | 
|  | 125 | +    print *, "test_optval_logical" | 
|  | 126 | +    call assert(foo_logical(.true.)) | 
|  | 127 | +    call assert(.not.foo_logical()) | 
|  | 128 | +  end subroutine test_optval_logical | 
|  | 129 | + | 
|  | 130 | +   | 
|  | 131 | +  function foo_logical(x) result(z) | 
|  | 132 | +    logical, intent(in), optional :: x | 
|  | 133 | +    logical :: z | 
|  | 134 | +    z = optval(x, .false.) | 
|  | 135 | +  endfunction foo_logical | 
|  | 136 | +   | 
|  | 137 | + | 
|  | 138 | +  subroutine test_optval_character | 
|  | 139 | +    print *, "test_optval_character" | 
|  | 140 | +    call assert(foo_character("x") == "x") | 
|  | 141 | +    call assert(foo_character() == "y") | 
|  | 142 | +  end subroutine test_optval_character | 
|  | 143 | + | 
|  | 144 | +   | 
|  | 145 | +  function foo_character(x) result(z) | 
|  | 146 | +    character(len=*), intent(in), optional :: x | 
|  | 147 | +    character(len=:), allocatable :: z | 
|  | 148 | +    z = optval(x, "y") | 
|  | 149 | +  endfunction foo_character | 
|  | 150 | +   | 
|  | 151 | +end program test_optval | 
0 commit comments