1! { dg-do run }
2!
3! PR 78848: [OOP] ICE on writing CLASS variable with non-typebound DTIO procedure
4!
5! Contributed by Mikael Morin <morin-mikael@orange.fr>
6
7module m
8  type :: t
9    integer :: i = 123
10  end type
11  interface write(formatted)
12    procedure wf
13  end interface
14contains
15  subroutine wf(this, unit, b, c, iostat, iomsg)
16    class(t), intent(in) :: this
17    integer, intent(in) :: unit
18    character(*), intent(in) :: b
19    integer, intent(in) :: c(:)
20    integer, intent(out) :: iostat
21    character(*), intent(inout) :: iomsg
22    write (unit, "(i3)", IOSTAT=iostat, IOMSG=iomsg) this%i
23  end subroutine
24end
25
26program p
27  use m
28  character(3) :: buffer
29  class(t), allocatable :: z
30  allocate(z)
31  write(buffer,"(DT)") z
32  if (buffer /= "123") STOP 1
33end
34