1! { dg-do compile }
2! { dg-options "-fdump-tree-original -Wc-binding-type" }
3!
4! PR fortran/34079
5! Character bind(c) arguments shall not pass the length as additional argument
6!
7
8subroutine multiArgTest()
9  implicit none
10interface ! Array
11  subroutine multiso_array(x,y) bind(c)
12    use iso_c_binding
13    character(kind=c_char,len=1), dimension(*) :: x,y
14  end subroutine multiso_array
15  subroutine multiso2_array(x,y) bind(c) ! { dg-warning "may not be C interoperable" }
16    character(len=1), dimension(*) :: x,y
17  end subroutine multiso2_array
18  subroutine mult_array(x,y)
19    use iso_c_binding
20    character(kind=c_char,len=1), dimension(*) :: x,y
21  end subroutine mult_array
22end interface
23
24interface ! Scalar: call by reference
25  subroutine multiso(x,y) bind(c)
26    use iso_c_binding
27    character(kind=c_char,len=1) :: x,y
28  end subroutine multiso
29  subroutine multiso2(x,y) bind(c) ! { dg-warning "may not be C interoperable" }
30    character(len=1) :: x,y
31  end subroutine multiso2
32  subroutine mult(x,y)
33    use iso_c_binding
34    character(kind=c_char,len=1) :: x,y
35  end subroutine mult
36end interface
37
38interface ! Scalar: call by VALUE
39  subroutine multiso_val(x,y) bind(c)
40    use iso_c_binding
41    character(kind=c_char,len=1), value :: x,y
42  end subroutine multiso_val
43  subroutine multiso2_val(x,y) bind(c) ! { dg-warning "may not be C interoperable" }
44    character(len=1), value :: x,y
45  end subroutine multiso2_val
46  subroutine mult_val(x,y)
47    use iso_c_binding
48    character(kind=c_char,len=1), value :: x,y
49  end subroutine mult_val
50end interface
51
52call mult_array    ("abc","ab")
53call multiso_array ("ABCDEF","ab")
54call multiso2_array("AbCdEfGhIj","ab")
55
56call mult    ("u","x")
57call multiso ("v","x")
58call multiso2("w","x")
59
60call mult_val    ("x","x")
61call multiso_val ("y","x")
62call multiso2_val("z","x")
63end subroutine multiArgTest
64
65program test
66implicit none
67
68interface ! Array
69  subroutine subiso_array(x) bind(c)
70    use iso_c_binding
71    character(kind=c_char,len=1), dimension(*) :: x
72  end subroutine subiso_array
73  subroutine subiso2_array(x) bind(c) ! { dg-warning "may not be C interoperable" }
74    character(len=1), dimension(*) :: x
75  end subroutine subiso2_array
76  subroutine sub_array(x)
77    use iso_c_binding
78    character(kind=c_char,len=1), dimension(*) :: x
79  end subroutine sub_array
80end interface
81
82interface ! Scalar: call by reference
83  subroutine subiso(x) bind(c)
84    use iso_c_binding
85    character(kind=c_char,len=1) :: x
86  end subroutine subiso
87  subroutine subiso2(x) bind(c) ! { dg-warning "may not be C interoperable" }
88    character(len=1) :: x
89  end subroutine subiso2
90  subroutine sub(x)
91    use iso_c_binding
92    character(kind=c_char,len=1) :: x
93  end subroutine sub
94end interface
95
96interface ! Scalar: call by VALUE
97  subroutine subiso_val(x) bind(c)
98    use iso_c_binding
99    character(kind=c_char,len=1), value :: x
100  end subroutine subiso_val
101  subroutine subiso2_val(x) bind(c) ! { dg-warning "may not be C interoperable" }
102    character(len=1), value :: x
103  end subroutine subiso2_val
104  subroutine sub_val(x)
105    use iso_c_binding
106    character(kind=c_char,len=1), value :: x
107  end subroutine sub_val
108end interface
109
110call sub_array    ("abc")
111call subiso_array ("ABCDEF")
112call subiso2_array("AbCdEfGhIj")
113
114call sub    ("u")
115call subiso ("v")
116call subiso2("w")
117
118call sub_val    ("x")
119call subiso_val ("y")
120call subiso2_val("z")
121end program test
122
123! Double argument dump:
124!
125! { dg-final { scan-tree-dump "mult_array .&.abc..1..lb: 1 sz: 1., &.ab..1..lb: 1 sz: 1., 3, 2.;" "original" } }
126! { dg-final { scan-tree-dump "multiso_array .&.ABCDEF..1..lb: 1 sz: 1., &.ab..1..lb: 1 sz: 1..;" "original" } }
127! { dg-final { scan-tree-dump "multiso2_array .&.AbCdEfGhIj..1..lb: 1 sz: 1., &.ab..1..lb: 1 sz: 1..;" "original" } }
128!
129! { dg-final { scan-tree-dump "mult .&.u..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1., 1, 1.;" "original" } }
130! { dg-final { scan-tree-dump "multiso .&.v..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1..;" "original" } }
131! { dg-final { scan-tree-dump "multiso2 .&.w..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1..;" "original" } }
132!
133! { dg-final { scan-tree-dump "mult_val ..x., .x., 1, 1.;" "original" } }
134! { dg-final { scan-tree-dump "multiso_val .121, 120.;" "original" } }
135! { dg-final { scan-tree-dump "multiso2_val ..z., .x..;" "original" } }
136!
137! Single argument dump:
138!
139! { dg-final { scan-tree-dump "sub_array .&.abc..1..lb: 1 sz: 1., 3.;" "original" } }
140! { dg-final { scan-tree-dump "subiso_array .&.ABCDEF..1..lb: 1 sz: 1..;" "original" } }
141! { dg-final { scan-tree-dump "subiso2_array .&.AbCdEfGhIj..1..lb: 1 sz: 1..;" "original" } }
142!
143! { dg-final { scan-tree-dump "sub .&.u..1..lb: 1 sz: 1., 1.;" "original" } }
144! { dg-final { scan-tree-dump "subiso .&.v..1..lb: 1 sz: 1..;" "original" } }
145! { dg-final { scan-tree-dump "subiso2 .&.w..1..lb: 1 sz: 1..;" "original" } }
146!
147! { dg-final { scan-tree-dump "sub_val ..x., 1.;" "original" } }
148! { dg-final { scan-tree-dump "subiso_val .121.;" "original" } }
149! { dg-final { scan-tree-dump "subiso2_val ..z..;" "original" } }
150!
151! { dg-final { cleanup-tree-dump "original" } }
152