flang/test/Semantics/bindings05.f90

   1 ! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
   2 module 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
  24 end
  25
  26 module 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
  41 end
  42
  43 module 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
  65 end
  66
  67 module 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
  82 end
  83
  84 module 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
 106 end
 107
 108 module 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
 123 end