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