1! { dg-do run } 2! Tests the fix for PR31867, in which the interface evaluation 3! of the character length of 'join' (ie. the length available in 4! the caller) was wrong. 5! 6! Contributed by <beliavsky@aol.com> 7! 8module util_mod 9 implicit none 10contains 11 function join (words, sep) result(str) 12 character (len=*), intent(in) :: words(:),sep 13 character (len = (size (words) - 1) * len_trim (sep) + & 14 sum (len_trim (words))) :: str 15 integer :: i,nw 16 nw = size (words) 17 str = "" 18 if (nw < 1) then 19 return 20 else 21 str = words(1) 22 end if 23 do i=2,nw 24 str = trim (str) // trim (sep) // words(i) 25 end do 26 end function join 27end module util_mod 28! 29program xjoin 30 use util_mod, only: join 31 implicit none 32 integer yy 33 character (len=5) :: words(5:8) = (/"two ","three","four ","five "/), sep = "^#^" 34 character (len=5) :: words2(4) = (/"bat ","ball ","goal ","stump"/), sep2 = "&" 35 36 if (join (words, sep) .ne. "two^#^three^#^four^#^five") call abort () 37 if (len (join (words, sep)) .ne. 25) call abort () 38 39 if (join (words(5:6), sep) .ne. "two^#^three") call abort () 40 if (len (join (words(5:6), sep)) .ne. 11) call abort () 41 42 if (join (words(7:8), sep) .ne. "four^#^five") call abort () 43 if (len (join (words(7:8), sep)) .ne. 11) call abort () 44 45 if (join (words(5:7:2), sep) .ne. "two^#^four") call abort () 46 if (len (join (words(5:7:2), sep)) .ne. 10) call abort () 47 48 if (join (words(6:8:2), sep) .ne. "three^#^five") call abort () 49 if (len (join (words(6:8:2), sep)) .ne. 12) call abort () 50 51 if (join (words2, sep2) .ne. "bat&ball&goal&stump") call abort () 52 if (len (join (words2, sep2)) .ne. 19) call abort () 53 54 if (join (words2(1:2), sep2) .ne. "bat&ball") call abort () 55 if (len (join (words2(1:2), sep2)) .ne. 8) call abort () 56 57 if (join (words2(2:4:2), sep2) .ne. "ball&stump") call abort () 58 if (len (join (words2(2:4:2), sep2)) .ne. 10) call abort () 59 60end program xjoin 61