gcc/testsuite/gfortran.dg/dec_structure_10.f90

   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
   9 module 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
  74 end module
  75
  76 use dec_structure_10
  77
  78 record /s1/ r
  79 record /s2/ struct
  80 record /s7/ r7
  81 integer i, j
  82 logical l
  83 struct%eq%i = 5
  84 i = -5
  85
  86 ! Nested access: struct has a member and which has a member b
  87 l =  struct .and. b   ! struct%and%b
  88 l =  struct .and. b .or. .false. ! (struct%and%b) .or. (.false.)
  89
  90 ! Intrinsic op: r has no member 'ne'
  91 j =  r .ne. i         ! <intrinsic> ne(r, i)
  92 j = (r) .ne. i        ! <intrinsic> ne(r, i)
  93
  94 ! Intrinsic op; r has a member 'ne' but it is not a record
  95 j =  r .ne. i         ! <intrinsic> ne(r, i)
  96 j = (r) .ne. i        ! <intrinsic> ne(r, i)
  97
  98 ! Nested access: struct has a member eq which has a member i
  99 j =  struct .eq. i    ! struct%eq%i
 100 if ( j .ne. struct%eq%i ) STOP 1
 101
 102 ! User op: struct is compared to i with eq_func
 103 j = (struct) .eq. i   ! eq_func(struct, i) -> struct%eq%i + i
 104 if ( 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
 107 j =  struct .test. i  ! tstfunc(struct, i) -> struct%i + i
 108 if ( j .ne. struct%i + i ) STOP 3
 109
 110 ! User op: struct is compared to i with eq_func
 111 j = (struct) .test. i ! tstfunc(struct, i) -> struct%i + i
 112 if ( j .ne. struct%i + i ) STOP 4
 113
 114 ! Deep nested access tests
 115 r7.r6.r5.r4.r3.r2.i = 1337
 116 j = r7.r6.r5.r4.r3.r2.i
 117 if ( j .ne. 1337 ) STOP 5
 118
 119 end