xref: /llvm-project/flang/test/Semantics/defined-ops.f90 (revision 01e22dfb104e7ab4737e512d4e1bbc609962b13e)
1! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
2
3! Check the analyzed form of a defined operator or assignment.
4
5! Type-bound defined assignment
6module m1
7  type :: t
8  contains
9    procedure :: b1 => s1
10    procedure, pass(y) :: b2 => s2
11    generic :: assignment(=) => b1, b2
12  end type
13contains
14  subroutine s1(x, y)
15    class(t), intent(out) :: x
16    integer, intent(in), value :: y
17  end
18  subroutine s2(x, y)
19    real, intent(out) :: x
20    class(t), intent(in) :: y
21  end
22  subroutine test1(x)
23    type(t) :: x
24    real :: a
25    integer :: j
26    !CHECK: CALL s1(x,1_4)
27    x = 1
28    j = 1
29    !CHECK: CALL s1(x,j)
30    x = j ! no parentheses due to VALUE
31    !CHECK: CALL s2(a,(x))
32    a = x
33  end
34  subroutine test2(x)
35    class(t) :: x
36    real :: a
37    !CHECK: CALL x%b1(1_4)
38    x = 1
39    !CHECK: CALL (x)%b2(a)
40    a = x
41  end
42end
43
44! Type-bound operator
45module m2
46  type :: t2
47  contains
48    procedure, pass(x2) :: b2 => f
49    generic :: operator(+) => b2
50  end type
51contains
52  integer pure function f(x1, x2)
53    class(t2), intent(in) :: x1
54    class(t2), intent(in) :: x2
55  end
56  subroutine test2(x, y)
57    class(t2) :: x
58    type(t2) :: y
59    !CHECK: i=f(x,y)
60    i = x + y
61    !CHECK: i=x%b2(y)
62    i = y + x
63  end
64end module
65
66! Non-type-bound assignment and operator
67module m3
68  type t
69  end type
70  interface assignment(=)
71    subroutine s1(x, y)
72      import
73      class(t), intent(out) :: x
74      integer, intent(in) :: y
75    end
76    subroutine s2(x, y)
77      real, intent(out) :: x
78      class(*), intent(in) :: y
79    end
80    subroutine s3(x, y)
81      integer, intent(out) :: x
82      class(*), intent(in), value :: y
83    end
84  end interface
85  interface operator(+)
86    integer function f(x, y)
87      import
88      class(t), intent(in) :: x, y
89    end
90  end interface
91contains
92  subroutine test(x, y, z)
93    class(t) :: x, y
94    class(*), intent(in) :: z
95    real :: a
96    !CHECK: CALL s1(x,2_4)
97    x = 2
98    !CHECK: i=f(x,y)
99    i = x + y
100    !CHECK: CALL s2(a,(z))
101    a = z
102    !CHECK: CALL s3(i,z)
103    i = z
104  end
105end
106