brintos

brintos / llvm-project-archived public Read only

0
0
Text · 2.6 KiB · 0ff5d62 Raw
82 lines · plain
1! RUN: %flang_fc1 -fdebug-dump-symbols %s 2>&1 | FileCheck %s2module ma3  type a4   contains5    procedure, private, nopass :: tbp_private => sub_a16    procedure, public, nopass :: tbp_public => sub_a27    generic, public :: gen => tbp_private, tbp_public8  end type9 contains10  subroutine sub_a1(w)11    character*(*), intent(in) :: w12    print *, w, ' -> a1'13  end14  subroutine sub_a2(w, j)15    character*(*), intent(in) :: w16    integer, intent(in) :: j17    print *, w, ' -> a2'18  end19  subroutine test_mono_a20    type(a) x21    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  end26  subroutine test_poly_a(x, w)27    class(a), intent(in) :: x28    character*(*), intent(in) :: w29    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  end34end35 36module mb37  use ma38  type, extends(a) :: ab39   contains40    procedure, private, nopass :: tbp_private => sub_ab141    procedure, public, nopass :: tbp_public => sub_ab242  end type43 contains44  subroutine sub_ab1(w)45    character*(*), intent(in) :: w46    print *, w, ' -> ab1'47  end48  subroutine sub_ab2(w, j)49    character*(*), intent(in) :: w50    integer, intent(in) :: j51    print *, w, ' -> ab2'52  end53  subroutine test_mono_ab54    type(ab) x55    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  end60  subroutine test_poly_ab(x, w)61    class(ab), intent(in) :: x62    character*(*), intent(in) :: w63    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  end68end69 70program main71  use mb72  call test_mono_a73  call test_mono_ab74  call test_poly_a(a(), 'a')75  call test_poly_a(ab(), 'ab')76  call test_poly_ab(ab(), 'ab')77end78 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: 182