1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
! { dg-do run }
!
! PR fortran/35203
!
! Test VALUE + OPTIONAL
! for integer/real/complex/logical which are passed by value
!
program main
implicit none
call value_test ()
contains
subroutine value_test (ii, rr, cc, ll, ii2, rr2, cc2, ll2)
integer, optional :: ii, ii2
real, optional :: rr, rr2
complex, optional :: cc, cc2
logical, optional :: ll, ll2
value :: ii, rr, cc, ll
call int_test (.false., 0)
call int_test (.false., 0, ii)
call int_test (.false., 0, ii2)
call int_test (.true., 0, 0)
call int_test (.true., 2, 2)
call real_test (.false., 0.0)
call real_test (.false., 0.0, rr)
call real_test (.false., 0.0, rr2)
call real_test (.true., 0.0, 0.0)
call real_test (.true., 2.0, 2.0)
call cmplx_test (.false., cmplx (0.0))
call cmplx_test (.false., cmplx (0.0), cc)
call cmplx_test (.false., cmplx (0.0), cc2)
call cmplx_test (.true., cmplx (0.0), cmplx (0.0))
call cmplx_test (.true., cmplx (2.0), cmplx (2.0))
call bool_test (.false., .false.)
call bool_test (.false., .false., ll)
call bool_test (.false., .false., ll2)
call bool_test (.true., .false., .false.)
call bool_test (.true., .true., .true.)
end subroutine value_test
subroutine int_test (ll, val, x)
logical, value :: ll
integer, value :: val
integer, value, optional :: x
if (ll .neqv. present(x)) call abort
if (present(x)) then
if (x /= val) call abort ()
endif
end subroutine int_test
subroutine real_test (ll, val, x)
logical, value :: ll
real, value :: val
real, value, optional :: x
if (ll .neqv. present(x)) call abort
if (present(x)) then
if (x /= val) call abort ()
endif
end subroutine real_test
subroutine cmplx_test (ll, val, x)
logical, value :: ll
complex, value :: val
complex, value, optional :: x
if (ll .neqv. present(x)) call abort
if (present(x)) then
if (x /= val) call abort ()
endif
end subroutine cmplx_test
subroutine bool_test (ll, val, x)
logical, value :: ll
logical, value :: val
logical, value, optional :: x
if (ll .neqv. present(x)) call abort
if (present(x)) then
if (x .neqv. val) call abort ()
endif
end subroutine bool_test
end program main
|
