blob: 21c531cdf1265adcb2b7f97185829c51b6166304 (
plain)
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
|
! { dg-do run }
! { dg-options "-fdec-structure" }
!
! Test passing STRUCTUREs through functions and subroutines.
!
subroutine aborts (s)
character(*), intent(in) :: s
print *, s
STOP 1
end subroutine
module dec_structure_7m
structure /s1/
integer i1
logical l1
real r1
character c1
end structure
structure /s2/
integer i
record /s1/ r1
endstructure
contains
! Pass structure through subroutine
subroutine sub (rec1, i)
implicit none
integer, intent(in) :: i
record /s1/ rec1
rec1.i1 = i
end subroutine
! Pass structure through function
function func (rec2, r)
implicit none
real, intent(in) :: r
record /s2/ rec2
real func
rec2.r1.r1 = r
func = rec2.r1.r1
return
end function
end module
program dec_structure_7
use dec_structure_7m
implicit none
record /s1/ r1
record /s2/ r2
real junk
! Passing through functions and subroutines
r1.i1 = 0
call sub (r1, 10)
r2.r1.r1 = 0.0
junk = func (r2, -20.14)
if (r1.i1 .ne. 10) then
call aborts("sub(r1, 10)")
endif
if (r2.r1.r1 .ne. -20.14) then
call aborts("func(r2, -20.14)")
endif
if (junk .ne. -20.14) then
print *, junk
call aborts("junk = func()")
endif
end program
|
