summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/bind_c_usage_13.f03
blob: d89963d8b1dc2e870545180ff2cf6cb844105bde (plain)
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" }
!
! 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" } }