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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
! { dg-do compile }
! { dg-options "-fdump-tree-original -Wc-binding-type" }
!
! PR fortran/34079
! Character bind(c) arguments shall not pass the length as additional argument
!
subroutine multiArgTest()
implicit none
interface ! Array
subroutine multiso_array(x,y) bind(c)
use iso_c_binding
character(kind=c_char,len=1), dimension(*) :: x,y
end subroutine multiso_array
subroutine multiso2_array(x,y) bind(c) ! { dg-warning "may not be C interoperable" }
character(len=1), dimension(*) :: x,y
end subroutine multiso2_array
subroutine mult_array(x,y)
use iso_c_binding
character(kind=c_char,len=1), dimension(*) :: x,y
end subroutine mult_array
end interface
interface ! Scalar: call by reference
subroutine multiso(x,y) bind(c)
use iso_c_binding
character(kind=c_char,len=1) :: x,y
end subroutine multiso
subroutine multiso2(x,y) bind(c) ! { dg-warning "may not be C interoperable" }
character(len=1) :: x,y
end subroutine multiso2
subroutine mult(x,y)
use iso_c_binding
character(kind=c_char,len=1) :: x,y
end subroutine mult
end interface
interface ! Scalar: call by VALUE
subroutine multiso_val(x,y) bind(c)
use iso_c_binding
character(kind=c_char,len=1), value :: x,y
end subroutine multiso_val
subroutine multiso2_val(x,y) bind(c) ! { dg-warning "may not be C interoperable" }
character(len=1), value :: x,y
end subroutine multiso2_val
subroutine mult_val(x,y)
use iso_c_binding
character(kind=c_char,len=1), value :: x,y
end subroutine mult_val
end interface
call mult_array ("abc","ab")
call multiso_array ("ABCDEF","ab")
call multiso2_array("AbCdEfGhIj","ab")
call mult ("u","x")
call multiso ("v","x")
call multiso2("w","x")
call mult_val ("x","x")
call multiso_val ("y","x")
call multiso2_val("z","x")
end subroutine multiArgTest
program test
implicit none
interface ! Array
subroutine subiso_array(x) bind(c)
use iso_c_binding
character(kind=c_char,len=1), dimension(*) :: x
end subroutine subiso_array
subroutine subiso2_array(x) bind(c) ! { dg-warning "may not be C interoperable" }
character(len=1), dimension(*) :: x
end subroutine subiso2_array
subroutine sub_array(x)
use iso_c_binding
character(kind=c_char,len=1), dimension(*) :: x
end subroutine sub_array
end interface
interface ! Scalar: call by reference
subroutine subiso(x) bind(c)
use iso_c_binding
character(kind=c_char,len=1) :: x
end subroutine subiso
subroutine subiso2(x) bind(c) ! { dg-warning "may not be C interoperable" }
character(len=1) :: x
end subroutine subiso2
subroutine sub(x)
use iso_c_binding
character(kind=c_char,len=1) :: x
end subroutine sub
end interface
interface ! Scalar: call by VALUE
subroutine subiso_val(x) bind(c)
use iso_c_binding
character(kind=c_char,len=1), value :: x
end subroutine subiso_val
subroutine subiso2_val(x) bind(c) ! { dg-warning "may not be C interoperable" }
character(len=1), value :: x
end subroutine subiso2_val
subroutine sub_val(x)
use iso_c_binding
character(kind=c_char,len=1), value :: x
end subroutine sub_val
end interface
call sub_array ("abc")
call subiso_array ("ABCDEF")
call subiso2_array("AbCdEfGhIj")
call sub ("u")
call subiso ("v")
call subiso2("w")
call sub_val ("x")
call subiso_val ("y")
call subiso2_val("z")
end program test
! Double argument dump:
!
! { dg-final { scan-tree-dump "mult_array .&.abc..1..lb: 1 sz: 1., &.ab..1..lb: 1 sz: 1., 3, 2.;" "original" } }
! { dg-final { scan-tree-dump "multiso_array .&.ABCDEF..1..lb: 1 sz: 1., &.ab..1..lb: 1 sz: 1..;" "original" } }
! { dg-final { scan-tree-dump "multiso2_array .&.AbCdEfGhIj..1..lb: 1 sz: 1., &.ab..1..lb: 1 sz: 1..;" "original" } }
!
! { dg-final { scan-tree-dump "mult .&.u..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1., 1, 1.;" "original" } }
! { dg-final { scan-tree-dump "multiso .&.v..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1..;" "original" } }
! { dg-final { scan-tree-dump "multiso2 .&.w..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1..;" "original" } }
!
! { dg-final { scan-tree-dump "mult_val ..x., .x., 1, 1.;" "original" } }
! { dg-final { scan-tree-dump "multiso_val .121, 120.;" "original" } }
! { dg-final { scan-tree-dump "multiso2_val ..z., .x..;" "original" } }
!
! Single argument dump:
!
! { dg-final { scan-tree-dump "sub_array .&.abc..1..lb: 1 sz: 1., 3.;" "original" } }
! { dg-final { scan-tree-dump "subiso_array .&.ABCDEF..1..lb: 1 sz: 1..;" "original" } }
! { dg-final { scan-tree-dump "subiso2_array .&.AbCdEfGhIj..1..lb: 1 sz: 1..;" "original" } }
!
! { dg-final { scan-tree-dump "sub .&.u..1..lb: 1 sz: 1., 1.;" "original" } }
! { dg-final { scan-tree-dump "subiso .&.v..1..lb: 1 sz: 1..;" "original" } }
! { dg-final { scan-tree-dump "subiso2 .&.w..1..lb: 1 sz: 1..;" "original" } }
!
! { dg-final { scan-tree-dump "sub_val ..x., 1.;" "original" } }
! { dg-final { scan-tree-dump "subiso_val .121.;" "original" } }
! { dg-final { scan-tree-dump "subiso2_val ..z..;" "original" } }
!
! { dg-final { cleanup-tree-dump "original" } }
|
