xref: /llvm-project/flang/test/Semantics/resolve110.f90 (revision 32332909f45b55aba4cfa7fac95e28cd174655f5)
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
6module 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
29end module
30
31module 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
55end module
56
57module 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
90end module
91