flang/test/Semantics/bindings07.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 => sub_a
   6     generic :: gen => tbp
   7   end type
   8   type, extends(a) :: aa
   9    contains
  10     procedure, private, nopass :: tbp => sub_aa
  11   end type
  12   type, extends(aa) :: aaa
  13    contains
  14     procedure, public, nopass :: tbp => sub_aaa
  15   end type
  16  contains
  17   subroutine sub_a(w)
  18     character*(*), intent(in) :: w
  19     print *, w, ' -> a'
  20   end
  21   subroutine sub_aa(w)
  22     character*(*), intent(in) :: w
  23     print *, w, ' -> aa'
  24   end
  25   subroutine sub_aaa(w)
  26     character*(*), intent(in) :: w
  27     print *, w, ' -> aaa'
  28   end
  29   subroutine mono1
  30     type(a) :: xa
  31     type(aa) :: xaa
  32     call xa%tbp('type(a) tbp')
  33     call xaa%tbp('type(aa) tbp')
  34   end
  35   subroutine pa(x, w)
  36     class(a), intent(in) :: x
  37     character*(*), intent(in) :: w
  38     call x%tbp('class(a) ' // w // ' tbp')
  39     call x%gen('class(a) ' // w // ' gen')
  40   end
  41   subroutine pta1
  42     call pa(a(), 'a')
  43     call pa(aa(), 'aa')
  44   end
  45   subroutine paa(x, w)
  46     class(aa), intent(in) :: x
  47     character*(*), intent(in) :: w
  48     call x%tbp('class(aa) ' // w // ' tbp')
  49     call x%gen('class(aa) ' // w // ' gen')
  50   end
  51   subroutine ptaa1
  52     call paa(aa(), 'aa')
  53   end
  54   subroutine paaa(x, w)
  55     class(aaa), intent(in) :: x
  56     character*(*), intent(in) :: w
  57     call x%tbp('class(aaa) ' // w // ' tbp')
  58     call x%gen('class(aaa) ' // w // ' gen')
  59   end
  60   subroutine ptaaa1
  61     call paaa(aaa(), 'aaa')
  62   end
  63 end
  64
  65 module mb
  66   use ma
  67   type, extends(a) :: ab
  68    contains
  69     procedure, public, nopass :: tbp => sub_ab
  70   end type
  71   type, extends(aa) :: aab
  72    contains
  73     procedure, public, nopass :: tbp => sub_aab
  74   end type
  75   type, extends(aaa) :: aaab
  76    contains
  77     procedure, public, nopass :: tbp => sub_aaab
  78   end type
  79   type, extends(ab) :: aba
  80    contains
  81     procedure, public, nopass :: tbp => sub_aba
  82   end type
  83   type, extends(aab) :: aaba
  84    contains
  85     procedure, public, nopass :: tbp => sub_aaba
  86   end type
  87   type, extends(aaab) :: aaaba
  88    contains
  89     procedure, public, nopass :: tbp => sub_aaaba
  90   end type
  91  contains
  92   subroutine sub_ab(w)
  93     character*(*), intent(in) :: w
  94     print *, w, ' -> ab'
  95   end
  96   subroutine sub_aab(w)
  97     character*(*), intent(in) :: w
  98     print *, w, ' -> aab'
  99   end
 100   subroutine sub_aaab(w)
 101     character*(*), intent(in) :: w
 102     print *, w, ' -> aaab'
 103   end
 104   subroutine sub_aba(w)
 105     character*(*), intent(in) :: w
 106     print *, w, ' -> aba'
 107   end
 108   subroutine sub_aaba(w)
 109     character*(*), intent(in) :: w
 110     print *, w, ' -> aaba'
 111   end
 112   subroutine sub_aaaba(w)
 113     character*(*), intent(in) :: w
 114     print *, w, ' -> aaaba'
 115   end
 116 end
 117
 118 module t
 119   use mb
 120  contains
 121   subroutine mono2
 122     type(a) :: xa
 123     type(aa) :: xaa
 124     type(aaa) :: xaaa
 125     type(ab) :: xab
 126     type(aab) :: xaab
 127     type(aaab) :: xaaab
 128     type(aba) :: xaba
 129     type(aaba) :: xaaba
 130     type(aaaba) :: xaaaba
 131     call xa%gen('type(a) gen')
 132     call xaa%gen('type(aa) gen')
 133     call xaaa%tbp('type(aaa) tbp')
 134     call xaaa%gen('type(aaa) gen')
 135     call xab%tbp('type(ab) tbp')
 136     call xab%gen('type(ab) gen')
 137     call xaab%tbp('type(aab) tbp')
 138     call xaab%gen('type(aab) gen')
 139     call xaaab%tbp('type(aaab) tbp')
 140     call xaaab%gen('type(aaab) gen')
 141     call xaba%tbp('type(aba) tbp')
 142     call xaba%gen('type(aba) gen')
 143     call xaaba%tbp('type(aaba) tbp')
 144     call xaaba%gen('type(aaba) gen')
 145     call xaaaba%tbp('type(aaaba) tbp')
 146     call xaaaba%gen('type(aaaba) gen')
 147   end
 148   subroutine pta2
 149     call pa(a(), 'a')
 150     call pa(aa(), 'aa')
 151     call pa(aaa(), 'aaa')
 152     call pa(ab(), 'ab')
 153     call pa(aab(), 'aab')
 154     call pa(aaab(), 'aaab')
 155     call pa(aba(), 'aba')
 156     call pa(aaba(), 'aaba')
 157     call pa(aaaba(), 'aaaba')
 158   end
 159   subroutine ptaa2
 160     call paa(aa(), 'aa')
 161     call paa(aaa(), 'aaa')
 162     call paa(aab(), 'aab')
 163     call paa(aaab(), 'aaab')
 164     call paa(aaba(), 'aaba')
 165     call paa(aaaba(), 'aaaba')
 166   end
 167   subroutine ptaaa2
 168     call paaa(aaa(), 'aaa')
 169     call paaa(aaab(), 'aaab')
 170     call paaa(aaaba(), 'aaaba')
 171   end
 172   subroutine pab(x, w)
 173     class(ab), intent(in) :: x
 174     character*(*), intent(in) :: w
 175     call x%tbp('class(ab) ' // w // ' tbp')
 176     call x%gen('class(ab) ' // w // ' gen')
 177   end
 178   subroutine ptab
 179     call pab(ab(), 'ab')
 180     call pab(aba(), 'aba')
 181   end
 182   subroutine paab(x, w)
 183     class(aab), intent(in) :: x
 184     character*(*), intent(in) :: w
 185     call x%tbp('class(aab) ' // w // ' tbp')
 186     call x%gen('class(aab) ' // w // ' gen')
 187   end
 188   subroutine ptaab
 189     call pa(aab(), 'aab')
 190     call pa(aaba(), 'aaba')
 191   end
 192   subroutine paaab(x, w)
 193     class(aaab), intent(in) :: x
 194     character*(*), intent(in) :: w
 195     call x%tbp('class(aaab) ' // w // ' tbp')
 196     call x%gen('class(aaab) ' // w // ' gen')
 197   end
 198   subroutine ptaaab
 199     call pa(aaab(), 'aaab')
 200     call pa(aaaba(), 'aaaba')
 201   end
 202   subroutine paba(x, w)
 203     class(aba), intent(in) :: x
 204     character*(*), intent(in) :: w
 205     call x%tbp('class(aba) ' // w // ' tbp')
 206     call x%gen('class(aba) ' // w // ' gen')
 207   end
 208   subroutine ptaba
 209     call paba(aba(), 'aba')
 210   end
 211   subroutine paaba(x, w)
 212     class(aaba), intent(in) :: x
 213     character*(*), intent(in) :: w
 214     call x%tbp('class(aaba) ' // w // ' tbp')
 215     call x%gen('class(aaba) ' // w // ' gen')
 216   end
 217   subroutine ptaaba
 218     call paaba(aaba(), 'aaba')
 219   end
 220   subroutine paaaba(x, w)
 221     class(aaaba), intent(in) :: x
 222     character*(*), intent(in) :: w
 223     call x%tbp('class(aaaba) ' // w // ' tbp')
 224     call x%gen('class(aaaba) ' // w // ' gen')
 225   end
 226   subroutine ptaaaba
 227     call pa(aaaba(), 'aaaba')
 228   end
 229 end
 230
 231 program main
 232   use t
 233   call mono1
 234   call mono2
 235   call pta1
 236   call ptaa1
 237   call ptaaa1
 238   call pta2
 239   call ptaa2
 240   call ptaaa2
 241   call ptab
 242   call ptaab
 243   call ptaaab
 244   call ptaba
 245   call ptaaba
 246   call ptaaaba
 247 end
 248
 249 !CHECK: .v.a, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=sub_a,name=.n.tbp)]
 250 !CHECK: .v.aa, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=sub_aa,name=.n.tbp)]
 251 !CHECK: .v.aaa, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=sub_aaa,name=.n.tbp)]
 252 !CHECK: .v.aaab, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=sub_aaab,name=.n.tbp)]
 253 !CHECK: .v.aaaba, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=sub_aaaba,name=.n.tbp)]
 254 !CHECK: .v.aab, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:1_8 init:[binding::binding(proc=sub_aa,name=.n.tbp),binding(proc=sub_aab,name=.n.tbp)]
 255 !CHECK: .v.aaba, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:1_8 init:[binding::binding(proc=sub_aa,name=.n.tbp),binding(proc=sub_aaba,name=.n.tbp)]
 256 !CHECK: .v.ab, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:1_8 init:[binding::binding(proc=sub_a,name=.n.tbp),binding(proc=sub_ab,name=.n.tbp)]
 257 !CHECK: .v.aba, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:1_8 init:[binding::binding(proc=sub_a,name=.n.tbp),binding(proc=sub_aba,name=.n.tbp)]
 258 !CHECK: tbp, NOPASS, PUBLIC: ProcBinding => sub_ab numPrivatesNotOverridden: 1
 259 !CHECK: tbp, NOPASS, PUBLIC: ProcBinding => sub_aab numPrivatesNotOverridden: 1
 260 !CHECK: tbp, NOPASS, PUBLIC: ProcBinding => sub_aba numPrivatesNotOverridden: 1
 261 !CHECK: tbp, NOPASS, PUBLIC: ProcBinding => sub_aaba numPrivatesNotOverridden: 1