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
|
module operator_overloading_25_mod
implicit none
type, public, abstract :: AbsType
contains
procedure(writeout), deferred :: writeout
generic :: write(formatted) => writeout
end type AbsType
abstract interface
subroutine writeout(self,unit,iotype,v_list,iostat,iomsg)
import
class(AbsType), intent(in) :: self
integer, intent(in) :: unit
character(*), intent(in) :: iotype
integer, intent(in) :: v_list(:)
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
end subroutine writeout
end interface
type, extends(AbsType) :: MyType
integer :: value
contains
procedure :: writeout => my_write
end type MyType
type :: IoType
contains
procedure, nopass :: output
end type IoType
contains
subroutine my_write(self,unit,iotype,v_list,iostat,iomsg)
class(MyType), intent(in) :: self
integer, intent(in) :: unit
character(*), intent(in) :: iotype
integer, intent(in) :: v_list(:)
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
iostat = 0
! Basic validation
if (len_trim(iotype) == 0) then
iostat = 1
iomsg = "Invalid iotype"
return
end if
write(unit,'(A,I0)') "MyType value = ", self%value
end subroutine my_write
subroutine output(obj)
class(AbsType), intent(in) :: obj
integer :: ios
character(len=200) :: msg
write(*,'(DT)', iostat=ios, iomsg=msg) obj
if (ios /= 0) then
print *, "I/O Error:", trim(msg)
error stop "DT write failed"
end if
end subroutine output
end module operator_overloading_25_mod
program operator_overloading_25
use operator_overloading_25_mod
implicit none
type(MyType) :: x
type(IoType) :: io
x%value = 42
call io%output(x)
print *, "operator_overloading_25 completed successfully."
end program operator_overloading_25
|
