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
|
! { dg-do run }
!
! PR fortran/95214
!
program chr_p
implicit none
integer, parameter :: u = 65
integer, parameter :: n = 26
character :: c(n)
integer :: i
c = [(achar(i), i=u,u+n-1)]
call chr_s(c, c)
call gfc_descriptor_c_char(c)
call s1(c)
call s1s_a(c)
call s1s_b(c)
call s2(c)
stop
contains
subroutine chr_s(a, b)
character, intent(in) :: a(..)
character, intent(in) :: b(:)
integer :: i
select rank(a)
rank(1)
do i = 1, size(a)
if(a(i)/=b(i)) stop 1
end do
rank default
stop 2
end select
return
end subroutine chr_s
! From Bug 66833
! Contributed by Damian Rouson <damian@sourceryinstitute.org>
subroutine gfc_descriptor_c_char(a)
character a(..)
if(rank(a)/=1) stop 3 ! ICE (also for lbound, ubound, and c_loc)
end subroutine gfc_descriptor_c_char
! From Bug 67938
! Contributed by Gerhard Steinmetz <gerhard.steinmetz.fortran@t-online.de>
! example z1.f90
subroutine s1(x)
character(1) :: x(..)
if(any(lbound(x)/=[1])) stop 4
if(any(ubound(x)/=[n])) stop 5
end subroutine s1
! example z1s.f90
subroutine s1s_a(x)
character :: x(..)
if(size(x)/=n) stop 6
end subroutine s1s_a
subroutine s1s_b(x)
character(77) :: x(..)
if(size(x)/=n) stop 7
end subroutine s1s_b
! example z2.f90
subroutine s2(x)
character(1) :: x(..)
if(lbound(x, dim=1)/=1) stop 8
if(ubound(x, dim=1)/=n) stop 9
if(size(x, dim=1)/=n) stop 10
end subroutine s2
end program chr_p
|
