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
|
! { dg-do run }
!
! Tests the fix for PR67674
!
! Contributed by Kristopher Kuhlman <kristopher.kuhlman@gmail.com>
!
program test
implicit none
type string_type
character(len=:), allocatable :: name
end type string_type
type(string_type), allocatable :: my_string_type
allocate(my_string_type)
allocate(character(len=0) :: my_string_type%name)
! print *, 'length main program before',len(my_string_type%name)
call inputreadword1(my_string_type%name)
! print *, 'length main program after',len(my_string_type%name)
! print *, 'final result:',my_string_type%name
if (my_string_type%name .ne. 'here the word is finally set') call abort
contains
subroutine inputreadword1(word_intermediate)
character(len=:), allocatable :: word_intermediate
! print *, 'length intermediate before',len(word_intermediate)
call inputreadword2(word_intermediate)
! print *, 'length intermediate after',len(word_intermediate)
! print *, word_intermediate
end subroutine inputreadword1
subroutine inputreadword2(word)
character(len=:), allocatable :: word
! print *, 'length inner before',len(word)
word = 'here the word is finally set' ! want automatic reallocation to happen here
! print *, 'length inner after',len(word)
! print *, word
end subroutine inputreadword2
end program test
|
