1! { dg-do compile }
2! { dg-options "-std=f2003" }
3!
4! PR fortran/57834
5!
6! (Gave a bogus warning before.)
7!
8program main
9
10    use iso_c_binding
11    use iso_fortran_env
12
13    implicit none
14
15    interface
16        function strerror(errno) bind(C, NAME = 'strerror')
17            import
18            type(C_PTR) :: strerror
19            integer(C_INT), value :: errno
20        end function
21    end interface
22
23    integer :: i
24    type(C_PTR) :: cptr
25    character(KIND=C_CHAR), pointer :: str(:)
26
27    cptr = strerror(INT(42, KIND = C_INT))
28    call C_F_POINTER(cptr, str, [255])
29
30    do i = 1, SIZE(str)
31        if (str(i) == C_NULL_CHAR) exit
32        write (ERROR_UNIT, '(A1)', ADVANCE = 'NO') str(i:i)
33    enddo
34
35    write (ERROR_UNIT, '(1X)')
36
37end program main
38