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
100
101
102
103
104
|
! { dg-do run }
! PR fortran/113866
!
! Check interoperability of assumed-length character (optional and
! non-optional) dummies between bind(c) and non-bind(c) procedures
module bindcchar
implicit none
integer, parameter :: n = 100, l = 10
contains
subroutine bindc_optional (c2, c4) bind(c)
character(*), optional :: c2, c4(n)
! print *, c2(1:3)
! print *, c4(5)(1:3)
if (.not. present (c2) .or. .not. present (c4)) stop 8
if (len (c2) /= l .or. len (c4) /= l) stop 81
if (c2(1:3) /= "a23") stop 1
if (c4(5)(1:3) /= "bcd") stop 2
end
subroutine bindc (c2, c4) bind(c)
character(*) :: c2, c4(n)
if (len (c2) /= l .or. len (c4) /= l) stop 82
if (c2(1:3) /= "a23") stop 3
if (c4(5)(1:3) /= "bcd") stop 4
call bindc_optional (c2, c4)
end
subroutine not_bindc_optional (c1, c3)
character(*), optional :: c1, c3(n)
if (.not. present (c1) .or. .not. present (c3)) stop 5
if (len (c1) /= l .or. len (c3) /= l) stop 83
call bindc_optional (c1, c3)
call bindc (c1, c3)
end
subroutine not_bindc_optional_deferred (c5, c6)
character(:), allocatable, optional :: c5, c6(:)
if (.not. present (c5) .or. .not. present (c6)) stop 6
if (len (c5) /= l .or. len (c6) /= l) stop 84
call not_bindc_optional (c5, c6)
call bindc_optional (c5, c6)
call bindc (c5, c6)
end
subroutine not_bindc_optional2 (c7, c8)
character(*), optional :: c7, c8(:)
if (.not. present (c7) .or. .not. present (c8)) stop 7
if (len (c7) /= l .or. len (c8) /= l) stop 85
call bindc_optional (c7, c8)
call bindc (c7, c8)
end
subroutine bindc_optional2 (c2, c4) bind(c)
character(*), optional :: c2, c4(n)
if (.not. present (c2) .or. .not. present (c4)) stop 8
if (len (c2) /= l .or. len (c4) /= l) stop 86
if (c2(1:3) /= "a23") stop 9
if (c4(5)(1:3) /= "bcd") stop 10
call bindc_optional (c2, c4)
call not_bindc_optional (c2, c4)
end
subroutine bindc_optional_missing (c1, c2, c3, c4, c5) bind(c)
character(*), optional :: c1, c2(n), c3(:), c4(..), c5(*)
if (present (c1)) stop 11
if (present (c2)) stop 12
if (present (c3)) stop 13
if (present (c4)) stop 14
if (present (c5)) stop 15
end
subroutine non_bindc_optional_missing (c1, c2, c3, c4, c5)
character(*), optional :: c1, c2(n), c3(:), c4(..), c5(*)
if (present (c1)) stop 21
if (present (c2)) stop 22
if (present (c3)) stop 23
if (present (c4)) stop 24
if (present (c5)) stop 25
end
end module
program p
use bindcchar
implicit none
character(l) :: a, b(n)
character(:), allocatable :: d, e(:)
a = 'a234567890'
b = 'bcdefghijk'
call not_bindc_optional (a, b)
call bindc_optional (a, b)
call not_bindc_optional2 (a, b)
call bindc_optional2 (a, b)
allocate (d, source=a)
allocate (e, source=b)
call not_bindc_optional (d, e)
call bindc_optional (d, e)
call not_bindc_optional2 (d, e)
call bindc_optional2 (d, e)
call not_bindc_optional_deferred (d, e)
deallocate (d, e)
call non_bindc_optional_missing ()
call bindc_optional_missing ()
end
|
