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