flang/test/Semantics/resolve110.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Exercise ways to define and extend non-type-bound generics
   3 ! TODO: crashes compiler (infinite recursion) when build with MSVC
   4 ! XFAIL: system-windows
   5
   6 module m1
   7   type :: t1; end type
   8   type :: t2; end type
   9   interface operator(.eq.)
  10     module procedure :: eq1
  11   end interface
  12   generic :: operator(==) => eq2
  13  contains
  14   logical function eq1(x, y)
  15     type(t1), intent(in) :: x
  16     type(t2), intent(in) :: y
  17     eq1 = .true.
  18   end function
  19   logical function eq2(y, x)
  20     type(t2), intent(in) :: y
  21     type(t1), intent(in) :: x
  22     eq2 = .true.
  23   end function
  24   subroutine test1
  25     type(t1) :: a
  26     type(t2) :: b
  27     if (a == b .and. b .eq. a) print *, 'ok'
  28   end subroutine
  29 end module
  30
  31 module m2
  32   use m1
  33   type :: t3; end type
  34   interface operator(==)
  35     module procedure eq3
  36   end interface
  37   generic :: operator(.eq.) => eq4
  38  contains
  39   logical function eq3(x, y)
  40     type(t1), intent(in) :: x
  41     type(t3), intent(in) :: y
  42     eq3 = .true.
  43   end function
  44   logical function eq4(y, x)
  45     type(t3), intent(in) :: y
  46     type(t1), intent(in) :: x
  47     eq4 = .true.
  48   end function
  49   subroutine test2
  50     type(t1) :: a
  51     type(t2) :: b
  52     type(t3) :: c
  53     if (a == b .and. b .eq. a .and. a == c .and. c .eq. a) print *, 'ok'
  54   end subroutine
  55 end module
  56
  57 module m3
  58   use m2
  59  contains
  60   logical function eq5(x, y)
  61     type(t2), intent(in) :: x
  62     type(t3), intent(in) :: y
  63     eq5 = .true.
  64   end function
  65   logical function eq6(y, x)
  66     type(t3), intent(in) :: y
  67     type(t2), intent(in) :: x
  68     eq6 = .true.
  69   end function
  70   subroutine test3
  71     interface operator(==)
  72       module procedure :: eq5
  73     end interface
  74     type(t1) :: a
  75     type(t2) :: b
  76     type(t3) :: c
  77     if (a == b .and. b .eq. a .and. a == c .and. c .eq. a .and. b == c) print *, 'ok'
  78     block
  79       generic :: operator(.eq.) => eq6
  80       if (a == b .and. b .eq. a .and. a == c .and. c .eq. a .and. b == c .and. c .eq. b) print *, 'ok'
  81     end block
  82    contains
  83     subroutine inner
  84       interface operator(.eq.)
  85         module procedure :: eq6
  86       end interface
  87       if (a == b .and. b .eq. a .and. a == c .and. c .eq. a .and. b == c .and. c .eq. b) print *, 'ok'
  88     end subroutine
  89   end subroutine
  90 end module