mirror of
https://github.com/autc04/Retro68.git
synced 2024-09-28 18:56:06 +00:00
99 lines
3.0 KiB
Fortran
99 lines
3.0 KiB
Fortran
! { dg-do compile }
|
|
!
|
|
! Tests the checks for interface compliance.
|
|
!
|
|
!
|
|
MODULE p
|
|
USE ISO_C_BINDING
|
|
|
|
TYPE :: person
|
|
CHARACTER (LEN=20) :: name
|
|
INTEGER(4) :: age
|
|
CONTAINS
|
|
procedure :: pwf ! { dg-error "Non-polymorphic passed-object" }
|
|
procedure :: pwuf
|
|
GENERIC :: WRITE(FORMATTED) => pwf
|
|
GENERIC :: WRITE(UNFORMATTED) => pwuf
|
|
END TYPE person
|
|
INTERFACE READ(FORMATTED)
|
|
MODULE PROCEDURE prf
|
|
END INTERFACE
|
|
INTERFACE READ(UNFORMATTED)
|
|
MODULE PROCEDURE pruf
|
|
END INTERFACE
|
|
|
|
TYPE :: seq_type
|
|
sequence
|
|
INTEGER(4) :: i
|
|
END TYPE seq_type
|
|
INTERFACE WRITE(FORMATTED)
|
|
MODULE PROCEDURE pwf_seq
|
|
END INTERFACE
|
|
|
|
TYPE, BIND(C) :: bindc_type
|
|
INTEGER(C_INT) :: i
|
|
END TYPE bindc_type
|
|
|
|
INTERFACE WRITE(FORMATTED)
|
|
MODULE PROCEDURE pwf_bindc
|
|
END INTERFACE
|
|
|
|
CONTAINS
|
|
SUBROUTINE pwf (dtv,unit,iotype,vlist,iostat,iomsg) ! { dg-error "must be of type CLASS" }
|
|
type(person), INTENT(IN) :: dtv
|
|
INTEGER, INTENT(IN) :: unit
|
|
CHARACTER (LEN=*), INTENT(IN) :: iotype
|
|
INTEGER, INTENT(IN) :: vlist(:)
|
|
INTEGER, INTENT(OUT) :: iostat
|
|
CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
|
|
WRITE(unit, FMT = *, IOSTAT=iostat) dtv%name, dtv%age
|
|
END SUBROUTINE pwf
|
|
|
|
SUBROUTINE prf (dtv,unit,iotype,vlist,iostat,iomsg) ! { dg-error "must be an ASSUMED SHAPE ARRAY" }
|
|
CLASS(person), INTENT(INOUT) :: dtv
|
|
INTEGER, INTENT(IN) :: unit
|
|
CHARACTER (LEN=*), INTENT(IN) :: iotype
|
|
INTEGER, INTENT(IN) :: vlist
|
|
INTEGER, INTENT(OUT) :: iostat
|
|
CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
|
|
READ (UNIT = UNIT, FMT = *) dtv%name, dtv%age
|
|
END SUBROUTINE prf
|
|
|
|
SUBROUTINE pwuf (dtv,unit,iostat,iomsg) ! { dg-error "must have INTENT IN" }
|
|
CLASS(person), INTENT(INOUT) :: dtv
|
|
INTEGER, INTENT(IN) :: unit
|
|
INTEGER, INTENT(OUT) :: iostat
|
|
CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
|
|
WRITE (UNIT=UNIT, FMT = *) DTV%name, DTV%age
|
|
END SUBROUTINE pwuf
|
|
|
|
SUBROUTINE pruf (dtv,unit,iostat,iomsg) ! { dg-error "must be of KIND = 4" }
|
|
CLASS(person), INTENT(INOUT) :: dtv
|
|
INTEGER, INTENT(IN) :: unit
|
|
INTEGER(8), INTENT(OUT) :: iostat
|
|
CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
|
|
READ (UNIT = UNIT, FMT = *) dtv%name, dtv%age
|
|
END SUBROUTINE pruf
|
|
|
|
SUBROUTINE pwf_seq (dtv,unit,iotype,vlist,iostat,iomsg) ! { dg-error "not extensible|DERIVED" }
|
|
class(seq_type), INTENT(IN) :: dtv
|
|
INTEGER, INTENT(IN) :: unit
|
|
CHARACTER (LEN=*), INTENT(IN) :: iotype
|
|
INTEGER, INTENT(IN) :: vlist(:)
|
|
INTEGER, INTENT(OUT) :: iostat
|
|
CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
|
|
WRITE(unit, FMT = *, IOSTAT=iostat) dtv%i
|
|
END SUBROUTINE pwf_seq
|
|
|
|
SUBROUTINE pwf_bindc (dtv,unit,iotype,vlist,iostat,iomsg) ! { dg-error "not extensible|DERIVED" }
|
|
class(bindc_type), INTENT(IN) :: dtv
|
|
INTEGER, INTENT(IN) :: unit
|
|
CHARACTER (LEN=*), INTENT(IN) :: iotype
|
|
INTEGER, INTENT(IN) :: vlist(:)
|
|
INTEGER, INTENT(OUT) :: iostat
|
|
CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
|
|
WRITE(unit, FMT = *, IOSTAT=iostat) dtv%i
|
|
END SUBROUTINE pwf_bindc
|
|
|
|
END MODULE p
|