blob: db7e4a83ba23f0f3a625e3f27eb0e9bb36b06734 [file] [log] [blame]
! { 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