flang/test/Semantics/bindings06.f90

   1 ! RUN: %flang_fc1 -fdebug-dump-symbols %s 2>&1 | FileCheck %s
   2 module 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
  34 end
  35
  36 module 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
  68 end
  69
  70 program 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')
  77 end
  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