! Program to test IO of derived types
|
! Program to test IO of derived types
|
program derived_io
|
program derived_io
|
character(100) :: buf1, buf2, buf3
|
character(100) :: buf1, buf2, buf3
|
|
|
type xyz_type
|
type xyz_type
|
integer :: x
|
integer :: x
|
character(11) :: y
|
character(11) :: y
|
logical :: z
|
logical :: z
|
end type xyz_type
|
end type xyz_type
|
|
|
type abcdef_type
|
type abcdef_type
|
integer :: a
|
integer :: a
|
logical :: b
|
logical :: b
|
type (xyz_type) :: c
|
type (xyz_type) :: c
|
integer :: d
|
integer :: d
|
real(4) :: e
|
real(4) :: e
|
character(11) :: f
|
character(11) :: f
|
end type abcdef_type
|
end type abcdef_type
|
|
|
type (xyz_type), dimension(2) :: xyz
|
type (xyz_type), dimension(2) :: xyz
|
type (abcdef_type) abcdef
|
type (abcdef_type) abcdef
|
|
|
xyz(1)%x = 11111
|
xyz(1)%x = 11111
|
xyz(1)%y = "hello world"
|
xyz(1)%y = "hello world"
|
xyz(1)%z = .true.
|
xyz(1)%z = .true.
|
xyz(2)%x = 0
|
xyz(2)%x = 0
|
xyz(2)%y = "go away"
|
xyz(2)%y = "go away"
|
xyz(2)%z = .false.
|
xyz(2)%z = .false.
|
|
|
abcdef%a = 0
|
abcdef%a = 0
|
abcdef%b = .true.
|
abcdef%b = .true.
|
abcdef%c%x = 111
|
abcdef%c%x = 111
|
abcdef%c%y = "bzz booo"
|
abcdef%c%y = "bzz booo"
|
abcdef%c%z = .false.
|
abcdef%c%z = .false.
|
abcdef%d = 3
|
abcdef%d = 3
|
abcdef%e = 4.0
|
abcdef%e = 4.0
|
abcdef%f = "kawabanga"
|
abcdef%f = "kawabanga"
|
|
|
write (buf1, *), xyz(1)%x, xyz(1)%y, xyz(1)%z
|
write (buf1, *), xyz(1)%x, xyz(1)%y, xyz(1)%z
|
! Use function call to ensure it is only evaluated once
|
! Use function call to ensure it is only evaluated once
|
write (buf2, *), xyz(bar())
|
write (buf2, *), xyz(bar())
|
if (buf1.ne.buf2) call abort
|
if (buf1.ne.buf2) call abort
|
|
|
write (buf1, *), abcdef
|
write (buf1, *), abcdef
|
write (buf2, *), abcdef%a, abcdef%b, abcdef%c, abcdef%d, abcdef%e, abcdef%f
|
write (buf2, *), abcdef%a, abcdef%b, abcdef%c, abcdef%d, abcdef%e, abcdef%f
|
write (buf3, *), abcdef%a, abcdef%b, abcdef%c%x, abcdef%c%y, &
|
write (buf3, *), abcdef%a, abcdef%b, abcdef%c%x, abcdef%c%y, &
|
abcdef%c%z, abcdef%d, abcdef%e, abcdef%f
|
abcdef%c%z, abcdef%d, abcdef%e, abcdef%f
|
if (buf1.ne.buf2) call abort
|
if (buf1.ne.buf2) call abort
|
if (buf1.ne.buf3) call abort
|
if (buf1.ne.buf3) call abort
|
|
|
call foo(xyz(1))
|
call foo(xyz(1))
|
|
|
contains
|
contains
|
|
|
subroutine foo(t)
|
subroutine foo(t)
|
type (xyz_type) t
|
type (xyz_type) t
|
write (buf1, *), t%x, t%y, t%z
|
write (buf1, *), t%x, t%y, t%z
|
write (buf2, *), t
|
write (buf2, *), t
|
if (buf1.ne.buf2) call abort
|
if (buf1.ne.buf2) call abort
|
end subroutine foo
|
end subroutine foo
|
|
|
integer function bar()
|
integer function bar()
|
integer, save :: i = 1
|
integer, save :: i = 1
|
bar = i
|
bar = i
|
i = i + 1
|
i = i + 1
|
end function
|
end function
|
end
|
end
|
|
|