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
|
! Like char_result_1.f90, but the string arguments are pointers.
! { dg-do run }
pure function double (string)
character (len = *), intent (in) :: string
character (len = len (string) * 2) :: double
double = string // string
end function double
function f1 (string)
character (len = *), pointer :: string
character (len = len (string)) :: f1
f1 = ''
end function f1
function f2 (string1, string2)
character (len = *), pointer :: string1
character (len = len (string1) - 20), pointer :: string2
character (len = len (string1) + len (string2) / 2) :: f2
f2 = ''
end function f2
program main
implicit none
interface
pure function double (string)
character (len = *), intent (in) :: string
character (len = len (string) * 2) :: double
end function double
function f1 (string)
character (len = *), pointer :: string
character (len = len (string)) :: f1
end function f1
function f2 (string1, string2)
character (len = *), pointer :: string1
character (len = len (string1) - 20), pointer :: string2
character (len = len (string1) + len (string2) / 2) :: f2
end function f2
end interface
integer :: a
character (len = 80) :: text
character (len = 70), target :: textt
character (len = 70), pointer :: textp
character (len = 50), pointer :: textp2
a = 42
textp => textt
textp2 => textt(1:50)
call test (f1 (textp), 70)
call test (f2 (textp, textp), 95)
call test (f3 (textp), 105)
call test (f4 (textp), 192)
call test (f5 (textp), 140)
call test (f6 (textp), 29)
call indirect (textp2)
contains
function f3 (string)
integer, parameter :: l1 = 30
character (len = *), pointer :: string
character (len = len (string) + l1 + 5) :: f3
f3 = ''
end function f3
function f4 (string)
character (len = len (text) - 10), pointer :: string
character (len = len (string) + len (text) + a) :: f4
f4 = ''
end function f4
function f5 (string)
character (len = *), pointer :: string
character (len = len (double (string))) :: f5
f5 = ''
end function f5
function f6 (string)
character (len = *), pointer :: string
character (len = len (string (a:))) :: f6
f6 = ''
end function f6
subroutine indirect (textp2)
character (len = 50), pointer :: textp2
call test (f1 (textp), 70)
call test (f2 (textp, textp), 95)
call test (f3 (textp), 105)
call test (f4 (textp), 192)
call test (f5 (textp), 140)
call test (f6 (textp), 29)
call test (f1 (textp2), 50)
call test (f2 (textp2, textp), 65)
call test (f3 (textp2), 85)
call test (f5 (textp2), 100)
call test (f6 (textp2), 9)
end subroutine indirect
subroutine test (string, length)
character (len = *) :: string
integer, intent (in) :: length
if (len (string) .ne. length) call abort
end subroutine test
end program main
|
