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