1 |
694 |
jeremybenn |
! { dg-do compile }
|
2 |
|
|
! { dg-options "-fdump-tree-original" }
|
3 |
|
|
!
|
4 |
|
|
! PR fortran/34079
|
5 |
|
|
! Bind(C) procedures shall have no character length
|
6 |
|
|
! dummy and actual arguments.
|
7 |
|
|
!
|
8 |
|
|
|
9 |
|
|
! SUBROUTINES
|
10 |
|
|
|
11 |
|
|
subroutine sub1noiso(a, b)
|
12 |
|
|
use iso_c_binding
|
13 |
|
|
implicit none
|
14 |
|
|
character(len=1,kind=c_char) :: a(*), b
|
15 |
|
|
character(len=1,kind=c_char):: x,z
|
16 |
|
|
integer(c_int) :: y
|
17 |
|
|
value :: b
|
18 |
|
|
print *, a(1:2), b
|
19 |
|
|
end subroutine sub1noiso
|
20 |
|
|
|
21 |
|
|
subroutine sub2(a, b) bind(c)
|
22 |
|
|
use iso_c_binding
|
23 |
|
|
implicit none
|
24 |
|
|
character(len=1,kind=c_char) :: a(*), b
|
25 |
|
|
character(len=1,kind=c_char):: x,z
|
26 |
|
|
integer(c_int) :: y
|
27 |
|
|
value :: b
|
28 |
|
|
print *, a(1:2), b
|
29 |
|
|
end subroutine sub2
|
30 |
|
|
|
31 |
|
|
! SUBROUTINES with ENTRY
|
32 |
|
|
|
33 |
|
|
subroutine sub3noiso(a, b)
|
34 |
|
|
use iso_c_binding
|
35 |
|
|
implicit none
|
36 |
|
|
character(len=1,kind=c_char) :: a(*), b
|
37 |
|
|
character(len=1,kind=c_char):: x,z
|
38 |
|
|
integer(c_int) :: y
|
39 |
|
|
value :: b
|
40 |
|
|
print *, a(1:2), b
|
41 |
|
|
entry sub3noisoEntry(x,y,z)
|
42 |
|
|
x = 'd'
|
43 |
|
|
end subroutine sub3noiso
|
44 |
|
|
|
45 |
|
|
subroutine sub4iso(a, b) bind(c)
|
46 |
|
|
use iso_c_binding
|
47 |
|
|
implicit none
|
48 |
|
|
character(len=1,kind=c_char) :: a(*), b
|
49 |
|
|
character(len=1,kind=c_char):: x,z
|
50 |
|
|
integer(c_int) :: y
|
51 |
|
|
value :: b
|
52 |
|
|
print *, a(1:2), b
|
53 |
|
|
entry sub4isoEntry(x,y,z)
|
54 |
|
|
x = 'd'
|
55 |
|
|
end subroutine sub4iso
|
56 |
|
|
|
57 |
|
|
subroutine sub5iso(a, b) bind(c)
|
58 |
|
|
use iso_c_binding
|
59 |
|
|
implicit none
|
60 |
|
|
character(len=1,kind=c_char) :: a(*), b
|
61 |
|
|
character(len=1,kind=c_char):: x,z
|
62 |
|
|
integer(c_int) :: y
|
63 |
|
|
value :: b
|
64 |
|
|
print *, a(1:2), b
|
65 |
|
|
entry sub5noIsoEntry(x,y,z)
|
66 |
|
|
x = 'd'
|
67 |
|
|
end subroutine sub5iso
|
68 |
|
|
|
69 |
|
|
subroutine sub6NoIso(a, b)
|
70 |
|
|
use iso_c_binding
|
71 |
|
|
implicit none
|
72 |
|
|
character(len=1,kind=c_char) :: a(*), b
|
73 |
|
|
character(len=1,kind=c_char):: x,z
|
74 |
|
|
integer(c_int) :: y
|
75 |
|
|
value :: b
|
76 |
|
|
print *, a(1:2), b
|
77 |
|
|
entry sub6isoEntry(x,y,z)
|
78 |
|
|
x = 'd'
|
79 |
|
|
end subroutine sub6NoIso
|
80 |
|
|
|
81 |
|
|
! The subroutines (including entry) should have
|
82 |
|
|
! only a char-length parameter if they are not bind(C).
|
83 |
|
|
!
|
84 |
|
|
! { dg-final { scan-tree-dump "sub1noiso \\(\[^.\]*a, \[^.\]*b, \[^.\]*_a, \[^.\]*_b\\)" "original" } }
|
85 |
|
|
! { dg-final { scan-tree-dump "sub2 \\(\[^.\]*a, \[^.\]*b\\)" "original" } }
|
86 |
|
|
! { dg-final { scan-tree-dump "sub3noiso \\(\[^.\]*a, \[^.\]*b, \[^.\]*_a, \[^.\]*_b\\)" "original" } }
|
87 |
|
|
! { dg-final { scan-tree-dump "sub3noisoentry \\(\[^.\]*x, \[^.\]*y, \[^.\]*z, \[^.\]*_x, \[^.\]*_z\\)" "original" } }
|
88 |
|
|
! { dg-final { scan-tree-dump "sub4iso \\(\[^.\]*a, \[^.\]*b\\)" "original" } }
|
89 |
|
|
! { dg-final { scan-tree-dump "sub4isoentry \\(\[^.\]*x, \[^.\]*y, \[^.\]*z, \[^.\]*_x, \[^.\]*_z\\)" "original" } }
|
90 |
|
|
! { dg-final { scan-tree-dump "sub5iso \\(\[^.\]*a, \[^.\]*b\\)" "original" } }
|
91 |
|
|
! { dg-final { scan-tree-dump "sub5noisoentry \\(\[^.\]*x, \[^.\]*y, \[^.\]*z, \[^.\]*_x, \[^.\]*_z\\)" "original" } }
|
92 |
|
|
! { dg-final { scan-tree-dump "sub6noiso \\(\[^.\]*a, \[^.\]*b, \[^.\]*_a, \[^.\]*_b\\)" "original" } }
|
93 |
|
|
! { dg-final { scan-tree-dump "sub6isoentry \\(\[^.\]*x, \[^.\]*y, \[^.\]*z, \[^.\]*_x, \[^.\]*_z\\)" "original" } }
|
94 |
|
|
|
95 |
|
|
! The master functions should have always a length parameter
|
96 |
|
|
! to ensure sharing a parameter between bind(C) and non-bind(C) works
|
97 |
|
|
!
|
98 |
|
|
! { dg-final { scan-tree-dump "master.0.sub3noiso \\(\[^.\]*__entry, \[^.\]*z, \[^.\]*y, \[^.\]*x, \[^.\]*b, \[^.\]*a, \[^.\]*_z, \[^.\]*_x, \[^.\]*_b, \[^.\]*_a\\)" "original" } }
|
99 |
|
|
! { dg-final { scan-tree-dump "master.1.sub4iso \\(\[^.\]*__entry, \[^.\]*z, \[^.\]*y, \[^.\]*x, \[^.\]*b, \[^.\]*a, \[^.\]*_z, \[^.\]*_x, \[^.\]*_b, \[^.\]*_a\\)" "original" } }
|
100 |
|
|
! { dg-final { scan-tree-dump "master.2.sub5iso \\(\[^.\]*__entry, \[^.\]*z, \[^.\]*y, \[^.\]*x, \[^.\]*b, \[^.\]*a, \[^.\]*_z, \[^.\]*_x, \[^.\]*_b, \[^.\]*_a\\)" "original" } }
|
101 |
|
|
! { dg-final { scan-tree-dump "master.3.sub6noiso \\(\[^.\]*__entry, \[^.\]*z, \[^.\]*y, \[^.\]*x, \[^.\]*b, \[^.\]*a, \[^.\]*_z, \[^.\]*_x, \[^.\]*_b, \[^.\]*_a\\)" "original" } }
|
102 |
|
|
|
103 |
|
|
! Thus, the master functions need to be called with length arguments
|
104 |
|
|
! present
|
105 |
|
|
!
|
106 |
|
|
! { dg-final { scan-tree-dump "master.0.sub3noiso .0, 0B, 0B, 0B, b, a, 0, 0, 1, 1\\);" "original" } }
|
107 |
|
|
! { dg-final { scan-tree-dump "master.0.sub3noiso .1, z, y, x, 0B, 0B, 1, 1, 0, 0\\);" "original" } }
|
108 |
|
|
! { dg-final { scan-tree-dump "master.1.sub4iso .0, 0B, 0B, 0B, b, a, 0, 0, 1, 1\\);" "original" } }
|
109 |
|
|
! { dg-final { scan-tree-dump "master.1.sub4iso .1, z, y, x, 0B, 0B, 1, 1, 0, 0\\);" "original" } }
|
110 |
|
|
! { dg-final { scan-tree-dump "master.2.sub5iso .0, 0B, 0B, 0B, b, a, 0, 0, 1, 1\\);" "original" } }
|
111 |
|
|
! { dg-final { scan-tree-dump "master.2.sub5iso .1, z, y, x, 0B, 0B, 1, 1, 0, 0\\);" "original" } }
|
112 |
|
|
! { dg-final { scan-tree-dump "master.3.sub6noiso .0, 0B, 0B, 0B, b, a, 0, 0, 1, 1\\);" "original" } }
|
113 |
|
|
! { dg-final { scan-tree-dump "master.3.sub6noiso .1, z, y, x, 0B, 0B, 1, 1, 0, 0\\);" "original" } }
|
114 |
|
|
|
115 |
|
|
! { dg-final { cleanup-tree-dump "original" } }
|