3 ! Test the fix for PR77657 in which the DTIO subroutine was not found,
4 ! which led to an error in attempting to link to the abstract interface.
6 ! Contributed by Damian Rouson <damian@sourceryinstitute.org>
11 type, abstract
:: parent
13 procedure(write_formatted_interface
), deferred
:: write_formatted
14 generic
:: write(formatted
) => write_formatted
18 subroutine write_formatted_interface(this
,unit
,iotype
,vlist
,iostat
,iomsg
)
20 class(parent
), intent(in
) :: this
21 integer, intent(in
) :: unit
22 character (len
=*), intent(in
) :: iotype
23 integer, intent(in
) :: vlist(:)
24 integer, intent(out
) :: iostat
25 character (len
=*), intent(inout
) :: iomsg
32 use abstract_parent
, only
: parent
35 type, extends(parent
) :: child
38 procedure
:: write_formatted
41 subroutine write_formatted(this
,unit
,iotype
,vlist
,iostat
,iomsg
)
42 class(child
), intent(in
) :: this
43 integer, intent(in
) :: unit
44 character (len
=*), intent(in
) :: iotype
45 integer, intent(in
) :: vlist(:)
46 integer, intent(out
) :: iostat
47 character (len
=*), intent(inout
) :: iomsg
48 write (unit
, "(i4)") this
%i
52 use child_module
, only
: child
55 integer :: v(1), istat
57 open (10, status
= "scratch")
58 call baby
%write_formatted(10, "abcd", v
, istat
, msg
) ! Call the dtio proc directly
61 if (trim (msg
) .ne
. "99") STOP 1
64 write (10,"(DT)") baby
! Call the dtio proc via the library
67 if (trim (msg
) .ne
. "42") STOP 2
69 write (10,"(DT)") child (77) ! The original testcase
72 if (trim (msg
) .ne
. "77") STOP 3
74 write (10,40) child (77) ! Modified using format label
78 if (trim (msg
) .ne
. "77") STOP 4