xref: /llvm-project/flang/test/Semantics/bindings05.f90 (revision 7f7bbc73175d94f63cba905191a4ecc341b9fdba) 
1! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
2module m1
3  type base
4   contains
5    procedure, private :: binding => basesub
6    generic :: generic => binding
7  end type
8  type, extends(base) :: ext1
9   contains
10    procedure, private :: binding => ext1sub
11  end type
12 contains
13  subroutine basesub(x)
14    class(base), intent(in) :: x
15  end
16  subroutine ext1sub(x)
17    class(ext1), intent(in) :: x
18  end
19  subroutine test1
20    type(ext1) x
21!CHECK: CALL ext1sub(x)
22    call x%generic
23  end
24end
25
26module m2
27  use m1
28  type, extends(ext1) :: ext2
29   contains
30    procedure :: binding => ext2sub
31  end type
32 contains
33  subroutine ext2sub(x)
34    class(ext2), intent(in) :: x
35  end
36  subroutine test2
37    type(ext2) x
38!CHECK: CALL ext1sub(x)
39    call x%generic ! private binding not overridable
40  end
41end
42
43module m3
44  type base
45   contains
46    procedure, public :: binding => basesub
47    generic :: generic => binding
48  end type
49  type, extends(base) :: ext1
50   contains
51    procedure, public :: binding => ext1sub
52  end type
53 contains
54  subroutine basesub(x)
55    class(base), intent(in) :: x
56  end
57  subroutine ext1sub(x)
58    class(ext1), intent(in) :: x
59  end
60  subroutine test1
61    type(ext1) x
62!CHECK: CALL ext1sub(x)
63    call x%generic
64  end
65end
66
67module m4
68  use m3
69  type, extends(ext1) :: ext2
70   contains
71    procedure :: binding => ext2sub
72  end type
73 contains
74  subroutine ext2sub(x)
75    class(ext2), intent(in) :: x
76  end
77  subroutine test2
78    type(ext2) x
79!CHECK: CALL ext2sub(x)
80    call x%generic ! public binding is overridable
81  end
82end
83
84module m5
85  type base
86   contains
87    procedure, private :: binding => basesub
88    generic :: generic => binding
89  end type
90  type, extends(base) :: ext1
91   contains
92    procedure, public :: binding => ext1sub
93  end type
94 contains
95  subroutine basesub(x)
96    class(base), intent(in) :: x
97  end
98  subroutine ext1sub(x)
99    class(ext1), intent(in) :: x
100  end
101  subroutine test1
102    type(ext1) x
103!CHECK: CALL ext1sub(x)
104    call x%generic
105  end
106end
107
108module m6
109  use m5
110  type, extends(ext1) :: ext2
111   contains
112    procedure :: binding => ext2sub
113  end type
114 contains
115  subroutine ext2sub(x)
116    class(ext2), intent(in) :: x
117  end
118  subroutine test2
119    type(ext2) x
120!CHECK: CALL ext2sub(x)
121    call x%generic ! public binding is overridable
122  end
123end
124