1! { dg-do run }
2!
3! Test the fix for PR64324 in which deferred length user ops
4! were being mistaken as assumed length and so rejected.
5!
6! Contributed by Ian Harvey  <ian_harvey@bigpond.com>
7!
8MODULE m
9  IMPLICIT NONE
10  INTERFACE OPERATOR(.ToString.)
11    MODULE PROCEDURE tostring
12  END INTERFACE OPERATOR(.ToString.)
13CONTAINS
14  FUNCTION tostring(arg)
15    INTEGER, INTENT(IN) :: arg
16    CHARACTER(:), ALLOCATABLE :: tostring
17    allocate (character(5) :: tostring)
18    write (tostring, "(I5)") arg
19  END FUNCTION tostring
20END MODULE m
21
22  use m
23  character(:), allocatable :: str
24  integer :: i = 999
25  str = .ToString. i
26  if (str .ne. "  999") call abort
27end
28
29