xref: /llvm-project/flang/test/Semantics/bindings06.f90 (revision 7f7bbc73175d94f63cba905191a4ecc341b9fdba)
1! RUN: %flang_fc1 -fdebug-dump-symbols %s 2>&1 | FileCheck %s
2module ma
3  type a
4   contains
5    procedure, private, nopass :: tbp_private => sub_a1
6    procedure, public, nopass :: tbp_public => sub_a2
7    generic, public :: gen => tbp_private, tbp_public
8  end type
9 contains
10  subroutine sub_a1(w)
11    character*(*), intent(in) :: w
12    print *, w, ' -> a1'
13  end
14  subroutine sub_a2(w, j)
15    character*(*), intent(in) :: w
16    integer, intent(in) :: j
17    print *, w, ' -> a2'
18  end
19  subroutine test_mono_a
20    type(a) x
21    call x%tbp_private('type(a) tbp_private')
22    call x%tbp_public('type(a) tbp_public', 0)
23    call x%gen('type(a) gen 1')
24    call x%gen('type(a) gen 2', 0)
25  end
26  subroutine test_poly_a(x, w)
27    class(a), intent(in) :: x
28    character*(*), intent(in) :: w
29    call x%tbp_private('class(a) (' // w // ') tbp_private')
30    call x%tbp_public('class(a) (' // w // ') tbp_public', 0)
31    call x%gen('class(a) (' // w // ') gen 1')
32    call x%gen('class(a) (' // w // ') gen 2', 0)
33  end
34end
35
36module mb
37  use ma
38  type, extends(a) :: ab
39   contains
40    procedure, private, nopass :: tbp_private => sub_ab1
41    procedure, public, nopass :: tbp_public => sub_ab2
42  end type
43 contains
44  subroutine sub_ab1(w)
45    character*(*), intent(in) :: w
46    print *, w, ' -> ab1'
47  end
48  subroutine sub_ab2(w, j)
49    character*(*), intent(in) :: w
50    integer, intent(in) :: j
51    print *, w, ' -> ab2'
52  end
53  subroutine test_mono_ab
54    type(ab) x
55    call x%tbp_private('type(ab) tbp_private')
56    call x%tbp_public('type(ab) tbp_public', 0)
57    call x%gen('type(ab) gen 1')
58    call x%gen('type(ab) gen 2', 0)
59  end
60  subroutine test_poly_ab(x, w)
61    class(ab), intent(in) :: x
62    character*(*), intent(in) :: w
63    call x%tbp_private('class(ab) (' // w // ') tbp_private')
64    call x%tbp_public('class(ab) (' // w // ') tbp_public', 0)
65    call x%gen('class(ab) (' // w // ') gen 1')
66    call x%gen('class(ab) (' // w // ') gen 2', 0)
67  end
68end
69
70program main
71  use mb
72  call test_mono_a
73  call test_mono_ab
74  call test_poly_a(a(), 'a')
75  call test_poly_a(ab(), 'ab')
76  call test_poly_ab(ab(), 'ab')
77end
78
79!CHECK: .v.a, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:1_8 init:[binding::binding(proc=sub_a1,name=.n.tbp_private),binding(proc=sub_a2,name=.n.tbp_public)]
80!CHECK: .v.ab, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:2_8 init:[binding::binding(proc=sub_a1,name=.n.tbp_private),binding(proc=sub_ab2,name=.n.tbp_public),binding(proc=sub_ab1,name=.n.tbp_private)]
81!CHECK: tbp_private, NOPASS, PRIVATE: ProcBinding => sub_ab1 numPrivatesNotOverridden: 1
82