1! { dg-do compile }
2!
3! PR fortran/49110
4! PR fortran/52843
5!
6! Based on a contributed code by jwmwalrus@gmail.com
7!
8! Before, character(len=:) result variable were rejected in PURE functions.
9!
10module mod1
11    use iso_c_binding
12    implicit none
13
14contains
15    pure function c_strlen(str)
16      character(KIND = C_CHAR), intent(IN) :: str(*)
17      integer :: c_strlen,i
18
19      i = 1
20      do
21        if (i < 1) then
22          c_strlen = 0
23          return
24        end if
25        if (str(i) == c_null_char) exit
26        i = i + 1
27      end do
28      c_strlen = i - 1
29    end function c_strlen
30    pure function c2fstring(cbuffer) result(string)
31        character(:), allocatable :: string
32        character(KIND = C_CHAR), intent(IN) :: cbuffer(*)
33        integer :: i
34
35    continue
36        string = REPEAT(' ', c_strlen(cbuffer))
37
38        do i = 1, c_strlen(cbuffer)
39            if (cbuffer(i) == C_NULL_CHAR) exit
40            string(i:i) = cbuffer(i)
41        enddo
42
43        string = TRIM(string)
44    end function
45end module mod1
46
47use mod1
48character(len=:), allocatable :: str
49str = c2fstring("ABCDEF"//c_null_char//"GHI")
50if (len(str) /= 6 .or. str /= "ABCDEF") call abort()
51end
52