1! { dg-do compile }
2!
3! Test fix for the original in PR793822 and for PR80156.
4!
5! Contributed by Walt Brainerd  <walt.brainerd@gmail.com>
6! and (PR80156)  <pedsxing@gmx.net>
7!
8module dollar_mod
9
10   implicit none
11   private
12
13   type, public :: dollar_type
14      real :: amount
15   contains
16      procedure :: Write_dollar
17      generic :: write(formatted) => Write_dollar
18   end type dollar_type
19
20   PRIVATE :: write (formatted) ! This used to ICE
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
40module pr80156
41
42   implicit none
43   private
44
45   type, public :: String
46      character(len=:), allocatable :: raw
47   end type
48
49   public :: write(unformatted) ! Gave an error due to the first fix for PR79382.
50   interface write(unformatted)
51      module procedure writeUnformatted
52   end interface
53
54contains
55
56   subroutine writeUnformatted(self, unit, iostat, iomsg)
57      class(String)   , intent(in)    :: self
58      integer         , intent(in)    :: unit
59      integer         , intent(out)   :: iostat
60      character(len=*), intent(inout) :: iomsg
61
62      if (allocated(self%raw)) then
63         write (unit, iostat=iostat, iomsg=iomsg) self%raw
64      else
65         write (unit, iostat=iostat, iomsg=iomsg) ''
66      endif
67
68   end subroutine
69
70end module
71
72  use dollar_mod
73  type(dollar_type) :: money
74  money = dollar_type(50.0)
75  print '(DT)', money ! Make sure that the typebound generic is accessible.
76end
77