gcc/testsuite/gfortran.dg/dtio_6.f90

   1 ! { dg-do compile }
   2 !
   3 ! Tests the checks for interface compliance.
   4 !
   5 !
   6 MODULE p
   7   USE ISO_C_BINDING
   8
   9   TYPE :: person
  10     CHARACTER (LEN=20) :: name
  11     INTEGER(4) :: age
  12     CONTAINS
  13       procedure :: pwf ! { dg-error "Non-polymorphic passed-object" }
  14       procedure :: pwuf
  15       GENERIC :: WRITE(FORMATTED) => pwf
  16       GENERIC :: WRITE(UNFORMATTED) => pwuf
  17   END TYPE person
  18   INTERFACE READ(FORMATTED)
  19     MODULE PROCEDURE prf
  20   END INTERFACE
  21   INTERFACE READ(UNFORMATTED)
  22     MODULE PROCEDURE pruf
  23   END INTERFACE
  24
  25   TYPE :: seq_type
  26     sequence
  27     INTEGER(4) :: i
  28   END TYPE seq_type
  29   INTERFACE WRITE(FORMATTED)
  30     MODULE PROCEDURE pwf_seq
  31   END INTERFACE
  32
  33   TYPE, BIND(C) :: bindc_type
  34     INTEGER(C_INT) :: i
  35   END TYPE bindc_type
  36
  37   INTERFACE WRITE(FORMATTED)
  38     MODULE PROCEDURE pwf_bindc
  39   END INTERFACE
  40
  41 CONTAINS
  42   SUBROUTINE pwf (dtv,unit,iotype,vlist,iostat,iomsg) ! { dg-error "must be of type CLASS" }
  43     type(person), INTENT(IN) :: dtv
  44     INTEGER, INTENT(IN) :: unit
  45     CHARACTER (LEN=*), INTENT(IN) :: iotype
  46     INTEGER, INTENT(IN) :: vlist(:)
  47     INTEGER, INTENT(OUT) :: iostat
  48     CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
  49     WRITE(unit, FMT = *, IOSTAT=iostat) dtv%name, dtv%age
  50   END SUBROUTINE pwf
  51
  52   SUBROUTINE prf (dtv,unit,iotype,vlist,iostat,iomsg) ! { dg-error "must be an ASSUMED SHAPE ARRAY" }
  53     CLASS(person), INTENT(INOUT) :: dtv
  54     INTEGER, INTENT(IN) :: unit
  55     CHARACTER (LEN=*), INTENT(IN) :: iotype
  56     INTEGER, INTENT(IN) :: vlist
  57     INTEGER, INTENT(OUT) :: iostat
  58     CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
  59     READ (UNIT = UNIT, FMT = *) dtv%name, dtv%age
  60   END SUBROUTINE prf
  61
  62   SUBROUTINE pwuf (dtv,unit,iostat,iomsg)  ! { dg-error "must have INTENT IN" }
  63     CLASS(person), INTENT(INOUT) :: dtv
  64     INTEGER, INTENT(IN) :: unit
  65     INTEGER, INTENT(OUT) :: iostat
  66     CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
  67     WRITE (UNIT=UNIT, FMT = *) DTV%name, DTV%age
  68   END SUBROUTINE pwuf
  69
  70   SUBROUTINE pruf (dtv,unit,iostat,iomsg)  ! { dg-error "must be of KIND = 4" }
  71     CLASS(person), INTENT(INOUT) :: dtv
  72     INTEGER, INTENT(IN) :: unit
  73     INTEGER(8), INTENT(OUT) :: iostat
  74     CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
  75     READ (UNIT = UNIT, FMT = *) dtv%name, dtv%age
  76   END SUBROUTINE pruf
  77
  78   SUBROUTINE pwf_seq (dtv,unit,iotype,vlist,iostat,iomsg) ! { dg-error "not extensible|DERIVED" }
  79     class(seq_type), INTENT(IN) :: dtv
  80     INTEGER, INTENT(IN) :: unit
  81     CHARACTER (LEN=*), INTENT(IN) :: iotype
  82     INTEGER, INTENT(IN) :: vlist(:)
  83     INTEGER, INTENT(OUT) :: iostat
  84     CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
  85     WRITE(unit, FMT = *, IOSTAT=iostat) dtv%i
  86   END SUBROUTINE pwf_seq
  87
  88   SUBROUTINE pwf_bindc (dtv,unit,iotype,vlist,iostat,iomsg) ! { dg-error "not extensible|DERIVED" }
  89     class(bindc_type), INTENT(IN) :: dtv
  90     INTEGER, INTENT(IN) :: unit
  91     CHARACTER (LEN=*), INTENT(IN) :: iotype
  92     INTEGER, INTENT(IN) :: vlist(:)
  93     INTEGER, INTENT(OUT) :: iostat
  94     CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
  95     WRITE(unit, FMT = *, IOSTAT=iostat) dtv%i
  96   END SUBROUTINE pwf_bindc
  97
  98 END MODULE p