1! { dg-do run }
2!
3! Test fix for the additional bug that was found in fixing PR79832.
4!
5! Contributed by Walt Brainerd  <walt.brainerd@gmail.com>
6!
7module dollar_mod
8
9   implicit none
10   private
11
12   type, public :: dollar_type
13      real :: amount
14   end type dollar_type
15
16   interface write(formatted)
17      module procedure Write_dollar
18   end interface
19
20   private :: write (formatted)
21
22contains
23
24subroutine Write_dollar &
25
26   (dollar_value, unit, b_edit_descriptor, v_list, iostat, iomsg)
27
28   class (dollar_type), intent(in) :: dollar_value
29   integer, intent(in) :: unit
30   character (len=*), intent(in) :: b_edit_descriptor
31   integer, dimension(:), intent(in) :: v_list
32   integer, intent(out) :: iostat
33   character (len=*), intent(inout) :: iomsg
34   write (unit=unit, fmt="(f9.2)", iostat=iostat) dollar_value%amount
35
36end subroutine Write_dollar
37
38end module dollar_mod
39
40program test_dollar
41
42   use :: dollar_mod
43   implicit none
44   integer  :: ios
45   character(100) :: errormsg
46
47   type (dollar_type), parameter :: wage = dollar_type(15.10)
48   write (unit=*, fmt="(DT)", iostat=ios, iomsg=errormsg) wage
49   if (ios.ne.5006) STOP 1
50   if (errormsg(1:22).ne."Missing DTIO procedure") STOP 2
51end program test_dollar
52