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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
! { dg-do run }
! PR fortran/113377
!
! Test that a NULL actual argument to an optional dummy is not present
! (see also F2018:15.5.2.12 on argument presence)
program test_null_actual_is_absent
implicit none
integer :: k(4) = 1
character :: c(4) = "#"
call one (k)
call three (c)
contains
subroutine one (i)
integer, intent(in) :: i(4)
integer :: kk = 2
integer, allocatable :: aa
integer, pointer :: pp => NULL()
print *, "Scalar integer"
call two (kk, aa)
call two (kk, pp)
call two (kk, NULL())
call two (kk, NULL(aa))
call two (kk, NULL(pp))
print *, "Elemental integer"
call two (i, aa)
call two (i, pp)
call two (i, NULL())
call two (i, NULL(aa))
call two (i, NULL(pp))
print *, "Scalar integer; value"
call two_val (kk, aa)
call two_val (kk, pp)
call two_val (kk, NULL())
call two_val (kk, NULL(aa))
call two_val (kk, NULL(pp))
print *, "Elemental integer; value"
call two_val (i, aa)
call two_val (i, pp)
call two_val (i, NULL())
call two_val (i, NULL(aa))
call two_val (i, NULL(pp))
end
elemental subroutine two (i, j)
integer, intent(in) :: i
integer, intent(in), optional :: j
if (present (j)) error stop 11
end
elemental subroutine two_val (i, j)
integer, intent(in) :: i
integer, value, optional :: j
if (present (j)) error stop 12
end
subroutine three (y)
character, intent(in) :: y(4)
character :: zz = "*"
character, allocatable :: aa
character, pointer :: pp => NULL()
print *, "Scalar character"
call four (zz, aa)
call four (zz, pp)
call four (zz, NULL())
call four (zz, NULL(aa))
call four (zz, NULL(pp))
print *, "Elemental character"
call four (y, aa)
call four (y, pp)
call four (y, NULL())
call four (y, NULL(aa))
call four (y, NULL(pp))
print *, "Scalar character; value"
call four_val (zz, aa)
call four_val (zz, pp)
call four_val (zz, NULL())
call four_val (zz, NULL(aa))
call four_val (zz, NULL(pp))
print *, "Elemental character; value"
call four_val (y, aa)
call four_val (y, pp)
call four_val (y, NULL())
call four_val (y, NULL(aa))
call four_val (y, NULL(pp))
end
elemental subroutine four (i, j)
character, intent(in) :: i
character, intent(in), optional :: j
if (present (j)) error stop 21
end
elemental subroutine four_val (i, j)
character, intent(in) :: i
character, value, optional :: j
if (present (j)) error stop 22
end
end
|
