1! { dg-do run } 2! Tests function return of deferred length scalars. 3! 4! Contributed by Paul Thomas <pault@gcc.gnu.org> 5! 6module m 7contains 8 function mfoo (carg) result(res) 9 character (:), allocatable :: res 10 character (*) :: carg 11 res = carg(2:4) 12 end function 13 function mbar (carg) 14 character (:), allocatable :: mbar 15 character (*) :: carg 16 mbar = carg(2:13) 17 end function 18end module 19 20 use m 21 character (:), allocatable :: lhs 22 lhs = foo ("foo calling ") 23 if (lhs .ne. "foo") call abort 24 if (len (lhs) .ne. 3) call abort 25 deallocate (lhs) 26 lhs = bar ("bar calling - baaaa!") 27 if (lhs .ne. "bar calling") call abort 28 if (len (lhs) .ne. 12) call abort 29 deallocate (lhs) 30 lhs = mfoo ("mfoo calling ") 31 if (lhs .ne. "foo") call abort 32 if (len (lhs) .ne. 3) call abort 33 deallocate (lhs) 34 lhs = mbar ("mbar calling - baaaa!") 35 if (lhs .ne. "bar calling") call abort 36 if (len (lhs) .ne. 12) call abort 37contains 38 function foo (carg) result(res) 39 character (:), allocatable :: res 40 character (*) :: carg 41 res = carg(1:3) 42 end function 43 function bar (carg) 44 character (:), allocatable :: bar 45 character (*) :: carg 46 bar = carg(1:12) 47 end function 48end 49