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
|
! PR fortran/39865
! { dg-do run }
subroutine f1 (a)
character(len=1) :: a(7:)
character(len=12) :: b
character(len=1) :: c(2:10)
write (b, a) 'Hell', 'o wo', 'rld!'
if (b .ne. 'Hello world!') call abort
write (b, a(:)) 'hell', 'o Wo', 'rld!'
if (b .ne. 'hello World!') call abort
write (b, a(8:)) 'Hell', 'o wo', 'rld!'
if (b .ne. 'Hello world!') call abort
c(2) = ' '
c(3) = '('
c(4) = '3'
c(5) = 'A'
c(6) = '4'
c(7) = ')'
write (b, c) 'hell', 'o Wo', 'rld!'
if (b .ne. 'hello World!') call abort
write (b, c(:)) 'Hell', 'o wo', 'rld!'
if (b .ne. 'Hello world!') call abort
write (b, c(3:)) 'hell', 'o Wo', 'rld!'
if (b .ne. 'hello World!') call abort
end subroutine f1
subroutine f2 (a)
character(len=1) :: a(10:,20:)
character(len=12) :: b
write (b, a) 'Hell', 'o wo', 'rld!'
if (b .ne. 'Hello world!') call abort
write (b, a) 'hell', 'o Wo', 'rld!'
if (b .ne. 'hello World!') call abort
end subroutine f2
function f3 ()
character(len=1) :: f3(5)
f3(1) = '('
f3(2) = '3'
f3(3) = 'A'
f3(4) = '4'
f3(5) = ')'
end function f3
interface
subroutine f1 (a)
character(len=1) :: a(:)
end
end interface
interface
subroutine f2 (a)
character(len=1) :: a(:,:)
end
end interface
interface
function f3 ()
character(len=1) :: f3(5)
end
end interface
integer :: i, j
character(len=1) :: e (6, 7:9), f (3,2), g (10)
character(len=12) :: b
e = 'X'
e(2,8) = ' '
e(3,8) = '('
e(4,8) = '3'
e(2,9) = 'A'
e(3,9) = '4'
e(4,9) = ')'
f = e(2:4,8:9)
g = 'X'
g(2) = ' '
g(3) = '('
g(4) = '3'
g(5) = 'A'
g(6) = '4'
g(7) = ')'
call f1 (g(2:7))
call f2 (f)
call f2 (e(2:4,8:9))
write (b, f3 ()) 'Hell', 'o wo', 'rld!'
if (b .ne. 'Hello world!') call abort
end
|
