blob: 992e2a7b0cbf27a933e58355875ad40313cdf757 [file] [log] [blame]
! { dg-do run }
!
! Tests dtio of transfer bind-C types.
!
! Note difficulties with c_char at -O1. This is why no character field is used.
!
MODULE p
USE ISO_C_BINDING
TYPE, BIND(C) :: person
integer(c_int) :: id_no
INTEGER(c_int) :: age
END TYPE person
INTERFACE WRITE(UNFORMATTED)
MODULE PROCEDURE pwuf
END INTERFACE
INTERFACE READ(UNFORMATTED)
MODULE PROCEDURE pruf
END INTERFACE
CONTAINS
SUBROUTINE pwuf (dtv,unit,iostat,iomsg)
type(person), INTENT(IN) :: dtv
INTEGER, INTENT(IN) :: unit
INTEGER, INTENT(OUT) :: iostat
CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
WRITE (UNIT=UNIT) DTV%id_no, DTV%age
END SUBROUTINE pwuf
SUBROUTINE pruf (dtv,unit,iostat,iomsg)
type(person), INTENT(INOUT) :: dtv
INTEGER, INTENT(IN) :: unit
INTEGER, INTENT(OUT) :: iostat
CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
READ (UNIT = UNIT) dtv%id_no, dtv%age
END SUBROUTINE pruf
END MODULE p
PROGRAM test
USE p
TYPE (person) :: chairman
CHARACTER (kind=c_char) :: cname(20)
integer (c_int) :: cage, cid_no
character(10) :: line
cid_no = 1
cage = 62
chairman%id_no = cid_no
chairman%age = cage
OPEN (UNIT=71, status = 'scratch', FORM='UNFORMATTED')
write (71) chairman
rewind (71)
chairman%id_no = 0
chairman%age = 0
read (71) chairman
close (unit = 71)
write(line, "(I4)") chairman%id_no
if (trim (line) .ne. " 1") STOP 1
write(line, "(I4)") chairman%age
if (trim (line) .ne. " 62") STOP 2
end program