|
111
|
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
|
|
|
7 module m
|
|
|
8 type :: t
|
|
|
9 integer :: i = 123
|
|
|
10 end type
|
|
|
11 interface write(formatted)
|
|
|
12 procedure wf
|
|
|
13 end interface
|
|
|
14 contains
|
|
|
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
|
|
|
24 end
|
|
|
25
|
|
|
26 program 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") call abort()
|
|
|
33 end
|
