1! { dg-do run }
2!
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.
7!
8! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
9!
10! The original comment #1 with an allocate statement.
11! Allocatable, deferred length scalar resul.
12function f()
13  character(len=:),allocatable :: f
14  allocate (f, source = "abc")
15  f ="ABC"
16end function
17!
18! Allocatable, deferred length, explicit, array result
19function g(a) result (res)
20  character(len=*) :: a(:)
21  character(len (a)) :: b(size (a))
22  character(len=:),allocatable :: res(:)
23  integer :: i
24  allocate (character(len(a)) :: res(2*size(a)))
25  do i = 1, len (a)
26    b(:)(i:i) = char (ichar (a(:)(i:i)) + 4)
27  end do
28  res = [a, b]
29end function
30!
31! Allocatable, deferred length, array result
32function h(a)
33  character(len=*) :: a(:)
34  character(len(a)) :: b (size(a))
35  character(len=:),allocatable :: h(:)
36  integer :: i
37  allocate (character(len(a)) :: h(size(a)))
38  do i = 1, len (a)
39    b(:)(i:i) = char (ichar (a(:)(i:i)) + 32)
40  end do
41  h = b
42end function
43
44module deferred_length_char_array
45contains
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
51  end function
52end module
53
54  use deferred_length_char_array
55  character(len=3) :: chr(3)
56  character(:), pointer :: s(:)
57  character(6) :: buffer
58  interface
59    function f()
60      character(len=:),allocatable :: f
61    end function
62    function g(a) result(res)
63      character(len=*) :: a(:)
64      character(len=:),allocatable :: res(:)
65    end function
66    function h(a)
67      character(len=*) :: a(:)
68      character(len=:),allocatable :: h(:)
69    end function
70  end interface
71
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
77
78! Comment #23
79  allocate(character(3)::s(2))
80  s(1) = 'foo'
81  s(2) = 'bar'
82  write (buffer, '(2A3)') s
83  if (buffer .ne. 'foobar') call abort
84end
85