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