gcc/testsuite/gfortran.dg/dtio_13.f90

   1 ! { dg-do compile }
   2 ! { dg-options -std=legacy }
   3 !
   4 ! Test elimination of various segfaults and ICEs on error recovery.
   5 !
   6 ! Contributed by Gerhard Steinmetz  <gerhard.steinmetz.fortran@t-online.de>
   7 !
   8 module m1
   9    type t
  10    end type
  11    interface write(formatted)
  12       module procedure s
  13    end interface
  14 contains
  15    subroutine s(dtv,unit,iotype,vlist,extra,iostat,iomsg) ! { dg-error "Too many dummy arguments" }
  16       class(t), intent(in) :: dtv
  17       integer, intent(in) :: unit
  18       character(len=*), intent(in) :: iotype
  19       integer, intent(in) :: vlist(:)
  20       integer, intent(out) :: iostat
  21       character(len=*), intent(inout) :: iomsg
  22    end
  23 end
  24
  25 module m2
  26    type t
  27    end type
  28    interface read(formatted)
  29       module procedure s
  30    end interface
  31 contains
  32    subroutine s(dtv,unit,iotype,vlist,iostat,iomsg,extra) ! { dg-error "Too many dummy arguments" }
  33       class(t), intent(inout) :: dtv
  34       integer, intent(in) :: unit
  35       character(len=*), intent(in) :: iotype
  36       integer, intent(in) :: vlist(:)
  37       integer, intent(out) :: iostat
  38       character(len=*), intent(inout) :: iomsg
  39    end
  40 end
  41
  42 module m3
  43    type t
  44    end type
  45    interface read(formatted)
  46       module procedure s
  47    end interface
  48 contains
  49    subroutine s(dtv,extra,unit,iotype,vlist,iostat,iomsg) ! { dg-error "Too many dummy arguments" }
  50       class(t), intent(inout) :: dtv
  51       integer, intent(in) :: unit
  52       character(len=*), intent(in) :: iotype
  53       integer, intent(in) :: vlist(:)
  54       integer, intent(out) :: iostat
  55       character(len=*), intent(inout) :: iomsg
  56    end
  57 end
  58
  59 module m4
  60    type t
  61    end type
  62    interface write(unformatted)
  63       module procedure s
  64    end interface
  65 contains
  66    subroutine s(*) ! { dg-error "Alternate return" }
  67    end
  68 end
  69
  70 module m5
  71    type t
  72    contains
  73       procedure :: s
  74       generic :: write(unformatted) => s
  75    end type
  76 contains
  77    subroutine s(dtv, *) ! { dg-error "Too few dummy arguments" }
  78       class(t), intent(out) :: dtv
  79    end
  80 end
  81
  82 module m6
  83    type t
  84       character(len=20) :: name
  85       integer(4) :: age
  86    contains
  87       procedure :: pruf
  88       generic :: read(unformatted) => pruf
  89    end type
  90 contains
  91    subroutine pruf (dtv,unit,*,iomsg) ! { dg-error "Alternate return" }
  92       class(t), intent(inout) :: dtv
  93       integer, intent(in) :: unit
  94       character(len=*), intent(inout) :: iomsg
  95       write (unit=unit, iostat=iostat, iomsg=iomsg) dtv%name, dtv%age
  96    end
  97 end
  98
  99 module m7
 100    type t
 101       character(len=20) :: name
 102       integer(4) :: age
 103    contains
 104       procedure :: pruf
 105       generic :: read(unformatted) => pruf
 106    end type
 107 contains
 108    subroutine pruf (dtv,unit,iostat) ! { dg-error "Too few dummy arguments" }
 109       class(t), intent(inout) :: dtv
 110       integer, intent(in) :: unit
 111       integer, intent(out) :: iostat
 112       character(len=1) :: iomsg
 113       write (unit=unit, iostat=iostat, iomsg=iomsg) dtv%name, dtv%age
 114    end
 115 end
 116
 117 module m
 118    type t
 119       character(len=20) :: name
 120       integer(4) :: age
 121    contains
 122       procedure :: pruf
 123       generic :: read(unformatted) => pruf
 124    end type
 125 contains
 126    subroutine pruf (dtv,unit,iostat,iomsg)
 127       class(t), intent(inout) :: dtv
 128       integer, intent(in) :: unit
 129       integer, intent(out) :: iostat
 130       character(len=*), intent(inout) :: iomsg
 131       write (unit=unit, iostat=iostat, iomsg=iomsg) dtv%name, dtv%age
 132    end
 133 end
 134 program test
 135    use m
 136    character(3) :: a, b
 137    class(t) :: chairman ! { dg-error "must be dummy, allocatable or pointer" }
 138    open (unit=71, file='myunformatted_data.dat', form='unformatted')
 139    read (71) a, chairman, b
 140    close (unit=71)
 141 end
 142