3 ! Test the fix for all the remaining issues in PR54070. These were all
4 ! concerned with deferred length characters being returned as function results,
5 ! except for comment #23 where the descriptor dtype was not correctly set and
6 ! array IO failed in consequence.
8 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
10 ! The original comment #1 with an allocate statement.
11 ! Allocatable, deferred length scalar resul.
13 character(len
=:),allocatable
:: f
14 allocate (f
, source
= "abc")
18 ! Allocatable, deferred length, explicit, array result
19 function g(a
) result (res
)
20 character(len
=*) :: a(:)
21 character(len (a
)) :: b(size (a
))
22 character(len
=:),allocatable
:: res(:)
24 allocate (character(len(a
)) :: res(2*size(a
)))
26 b(:)(i
:i
) = char (ichar (a(:)(i
:i
)) + 4)
31 ! Allocatable, deferred length, array result
33 character(len
=*) :: a(:)
34 character(len(a
)) :: b (size(a
))
35 character(len
=:),allocatable
:: h(:)
37 allocate (character(len(a
)) :: h(size(a
)))
39 b(:)(i
:i
) = char (ichar (a(:)(i
:i
)) + 32)
44 module deferred_length_char_array
46 function return_string(argument
)
47 character(*) :: argument
48 character(:), dimension(:), allocatable
:: return_string
49 allocate (character (len(argument
)) :: return_string(2))
50 return_string
= argument
54 use deferred_length_char_array
55 character(len
=3) :: chr(3)
56 character(:), pointer :: s(:)
57 character(6) :: buffer
60 character(len
=:),allocatable
:: f
62 function g(a
) result(res
)
63 character(len
=*) :: a(:)
64 character(len
=:),allocatable
:: res(:)
67 character(len
=*) :: a(:)
68 character(len
=:),allocatable
:: h(:)
72 if (f () .ne
. "ABC") call abort
73 if (any (g (["ab","cd"]) .ne
. ["ab","cd","ef","gh"])) call abort
74 chr
= h (["ABC","DEF","GHI"])
75 if (any (chr
.ne
. ["abc","def","ghi"])) call abort
76 if (any (return_string ("abcdefg") .ne
. ["abcdefg","abcdefg"])) call abort
79 allocate(character(3)::s(2))
82 write (buffer
, '(2A3)') s
83 if (buffer
.ne
. 'foobar') call abort