1! { dg-do run }
2! { dg-options "-fdec-structure" }
3!
4! Runtime tests for rules governing dot ('.') as a member accessor, including
5! voodoo with aliased user-defined vs. intrinsic operators and nested members.
6! See gcc/fortran/match.c (gfc_match_member_sep).
7!
8
9module dec_structure_10
10  ! Operator overload tests with .ne. and constant member
11  structure /s1/
12    integer i
13    integer ne
14    logical b
15  end structure
16
17  ! Operator overload tests with .eq., .test. and nested members
18  structure /s2/
19    record /s1/ eq
20    record /s1/ test
21    record /s1/ and
22    integer i
23  end structure
24
25  ! Deep nested access tests
26  structure /s3/
27    record /s2/ r2
28  end structure
29  structure /s4/
30    record /s3/ r3
31  end structure
32  structure /s5/
33    record /s4/ r4
34  end structure
35  structure /s6/
36    record /s5/ r5
37  end structure
38  structure /s7/
39    record /s6/ r6
40  end structure
41
42  ! Operator overloads to mess with nested member accesses
43  interface operator (.ne.)
44    module procedure ne_func
45  end interface operator (.ne.)
46  interface operator (.eq.)
47    module procedure eq_func
48  end interface operator (.eq.)
49  interface operator (.test.)
50    module procedure tstfunc
51  end interface operator (.test.)
52  contains
53  ! ne_func will be called on (x) .ne. (y)
54  function ne_func (r, i)
55    integer, intent(in) :: i
56    type(s1), intent(in) :: r
57    integer ne_func
58    ne_func = r%i + i
59  end function
60  ! eq_func will be called on (x) .eq. (y)
61  function eq_func (r, i)
62    integer, intent(in) :: i
63    type(s2), intent(in) :: r
64    integer eq_func
65    eq_func = r%eq%i + i
66  end function eq_func
67  ! tstfunc will be called on (x) .test. (y)
68  function tstfunc (r, i)
69    integer, intent(in) :: i
70    type(s2), intent(in) :: r
71    integer tstfunc
72    tstfunc = r%i + i
73  end function tstfunc
74end module
75
76use dec_structure_10
77
78record /s1/ r
79record /s2/ struct
80record /s7/ r7
81integer i, j
82logical l
83struct%eq%i = 5
84i = -5
85
86! Nested access: struct has a member and which has a member b
87l =  struct .and. b   ! struct%and%b
88l =  struct .and. b .or. .false. ! (struct%and%b) .or. (.false.)
89
90! Intrinsic op: r has no member 'ne'
91j =  r .ne. i         ! <intrinsic> ne(r, i)
92j = (r) .ne. i        ! <intrinsic> ne(r, i)
93
94! Intrinsic op; r has a member 'ne' but it is not a record
95j =  r .ne. i         ! <intrinsic> ne(r, i)
96j = (r) .ne. i        ! <intrinsic> ne(r, i)
97
98! Nested access: struct has a member eq which has a member i
99j =  struct .eq. i    ! struct%eq%i
100if ( j .ne. struct%eq%i ) STOP 1
101
102! User op: struct is compared to i with eq_func
103j = (struct) .eq. i   ! eq_func(struct, i) -> struct%eq%i + i
104if ( j .ne. struct%eq%i + i ) STOP 2
105
106! User op: struct has a member test which has a member i, but test is a uop
107j =  struct .test. i  ! tstfunc(struct, i) -> struct%i + i
108if ( j .ne. struct%i + i ) STOP 3
109
110! User op: struct is compared to i with eq_func
111j = (struct) .test. i ! tstfunc(struct, i) -> struct%i + i
112if ( j .ne. struct%i + i ) STOP 4
113
114! Deep nested access tests
115r7.r6.r5.r4.r3.r2.i = 1337
116j = r7.r6.r5.r4.r3.r2.i
117if ( j .ne. 1337 ) STOP 5
118
119end
120