gcc/testsuite/gfortran.dg/dtio_23.f90

   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 !
   8 module 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
  22 contains
  23
  24 subroutine 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
  36 end subroutine Write_dollar
  37
  38 end module dollar_mod
  39
  40 module 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
  54 contains
  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
  70 end 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.
  76 end