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