! { dg-do run } ! ! Functional test of User Defined DT IO, unformatted WRITE/READ ! ! 1) Tests unformatted DTV write with other variables in the record ! 2) Tests reading back the recods written. ! module p type :: person character (len=20) :: name integer(4) :: age contains procedure :: pwuf procedure :: pruf generic :: write(unformatted) => pwuf generic :: read(unformatted) => pruf end type person contains subroutine pwuf (dtv,unit,iostat,iomsg) class(person), intent(in) :: dtv integer, intent(in) :: unit integer, intent(out) :: iostat character (len=*), intent(inout) :: iomsg write (unit=unit, iostat=iostat, iomsg=iomsg) dtv%name, dtv%age end subroutine pwuf subroutine pruf (dtv,unit,iostat,iomsg) class(person), intent(inout) :: dtv integer, intent(in) :: unit integer, intent(out) :: iostat character (len=*), intent(inout) :: iomsg read (unit = unit) dtv%name, dtv%age end subroutine pruf end module p program test use p type (person), save :: chairman character(3) :: tmpstr1, tmpstr2 chairman%name="charlie" chairman%age=62 open (unit=71, file='myunformatted_data.dat', form='unformatted') write (71) "abc", chairman, "efg" write (71) "hij", chairman, "klm" write (71) "nop", chairman, "qrs" rewind (unit = 71) chairman%name="boggle" chairman%age=1234 read (71) tmpstr1, chairman, tmpstr2 if (tmpstr1.ne."abc") STOP 1 if (tmpstr2.ne."efg") STOP 2 if (chairman%name.ne."charlie") STOP 3 if (chairman%age.ne.62) STOP 4 chairman%name="boggle" chairman%age=1234 read (71) tmpstr1, chairman, tmpstr2 if (tmpstr1.ne."hij") STOP 5 if (tmpstr2.ne."klm") STOP 6 if (chairman%name.ne."charlie") STOP 7 if (chairman%age.ne.62) STOP 8 chairman%name="boggle" chairman%age=1234 read (71) tmpstr1, chairman, tmpstr2 if (tmpstr1.ne."nop") STOP 9 if (tmpstr2.ne."qrs") STOP 10 if (chairman%name.ne."charlie") STOP 11 if (chairman%age.ne.62) STOP 12 close (unit = 71, status='delete') end program test