gcc/testsuite/gfortran.dg/dtio_24.f90

   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 !
   7 module 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
  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 program 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) call abort
  50    if (errormsg(1:22).ne."Missing DTIO procedure") call abort
  51 end program test_dollar