flang/test/Semantics/bindings01.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Confirm enforcement of constraints and restrictions in 7.5.7.3
   3 ! and C733, C734 and C779, C780, C782, C783, C784, and C785.
   4
   5 module m
   6   !ERROR: An ABSTRACT derived type must be extensible
   7   !PORTABILITY: A derived type with the BIND attribute is empty
   8   type, abstract, bind(c) :: badAbstract1
   9   end type
  10   !ERROR: An ABSTRACT derived type must be extensible
  11   type, abstract :: badAbstract2
  12     sequence
  13     real :: badAbstract2Field
  14   end type
  15   type, abstract :: abstract
  16    contains
  17     !ERROR: DEFERRED is required when an interface-name is provided
  18     procedure(s1), pass :: ab1
  19     !ERROR: Type-bound procedure 'ab3' may not be both DEFERRED and NON_OVERRIDABLE
  20     procedure(s1), deferred, non_overridable :: ab3
  21     !ERROR: DEFERRED is only allowed when an interface-name is provided
  22     procedure, deferred, non_overridable :: ab4 => s1
  23   end type
  24   type :: nonoverride
  25    contains
  26     procedure, non_overridable, nopass :: no1 => s1
  27   end type
  28   type, extends(nonoverride) :: nonoverride2
  29   end type
  30   type, extends(nonoverride2) :: nonoverride3
  31    contains
  32     !ERROR: Override of NON_OVERRIDABLE 'no1' is not permitted
  33     procedure, nopass :: no1 => s1
  34   end type
  35   type, abstract :: missing
  36    contains
  37     procedure(s4), deferred :: am1
  38   end type
  39   !ERROR: Non-ABSTRACT extension of ABSTRACT derived type 'missing' lacks a binding for DEFERRED procedure 'am1'
  40   type, extends(missing) :: concrete
  41   end type
  42   type, extends(missing) :: intermediate
  43    contains
  44     procedure :: am1 => s7
  45   end type
  46   type, extends(intermediate) :: concrete2  ! ensure no false missing binding error
  47   end type
  48   !WARNING: A derived type with the BIND attribute is empty
  49   type, bind(c) :: inextensible1
  50   end type
  51   !ERROR: The parent type is not extensible
  52   type, extends(inextensible1) :: badExtends1
  53   end type
  54   type :: inextensible2
  55     sequence
  56     real :: inextensible2Field
  57   end type
  58   !ERROR: The parent type is not extensible
  59   type, extends(inextensible2) :: badExtends2
  60   end type
  61   !ERROR: Derived type 'real' not found
  62   type, extends(real) :: badExtends3
  63   end type
  64   type :: base
  65     real :: component
  66    contains
  67     !ERROR: Procedure bound to non-ABSTRACT derived type 'base' may not be DEFERRED
  68     procedure(s2), deferred :: bb1
  69     !ERROR: DEFERRED is only allowed when an interface-name is provided
  70     procedure, deferred :: bb2 => s2
  71   end type
  72   type, extends(base) :: extension
  73    contains
  74      !ERROR: A type-bound procedure binding may not have the same name as a parent component
  75      procedure :: component => s3
  76   end type
  77   type :: nopassBase
  78    contains
  79     procedure, nopass :: tbp => s1
  80   end type
  81   type, extends(nopassBase) :: passExtends
  82    contains
  83     !ERROR: A passed-argument type-bound procedure may not override a NOPASS procedure
  84     procedure :: tbp => s5
  85   end type
  86   type :: passBase
  87    contains
  88     procedure :: tbp => s6
  89   end type
  90   type, extends(passBase) :: nopassExtends
  91    contains
  92     !ERROR: A NOPASS type-bound procedure may not override a passed-argument procedure
  93     procedure, nopass :: tbp => s1
  94   end type
  95  contains
  96   subroutine s1(x)
  97     class(abstract), intent(in) :: x
  98   end subroutine s1
  99   subroutine s2(x)
 100     class(base), intent(in) :: x
 101   end subroutine s2
 102   subroutine s3(x)
 103     class(extension), intent(in) :: x
 104   end subroutine s3
 105   subroutine s4(x)
 106     class(missing), intent(in) :: x
 107   end subroutine s4
 108   subroutine s5(x)
 109     class(passExtends), intent(in) :: x
 110   end subroutine s5
 111   subroutine s6(x)
 112     class(passBase), intent(in) :: x
 113   end subroutine s6
 114   subroutine s7(x)
 115     class(intermediate), intent(in) :: x
 116   end subroutine s7
 117 end module
 118
 119 module m1
 120   implicit none
 121   interface g
 122     module procedure mp
 123   end interface g
 124
 125   type t
 126   contains
 127     !ERROR: The binding of 'tbp' ('g') must be either an accessible module procedure or an external procedure with an explicit interface
 128     procedure,pass(x) :: tbp => g
 129   end type t
 130
 131 contains
 132   subroutine mp(x)
 133     class(t),intent(in) :: x
 134   end subroutine
 135 end module m1
 136
 137 module m2
 138   type parent
 139     real realField
 140   contains
 141     !ERROR: Procedure binding 'proc' with no dummy arguments must have NOPASS attribute
 142     procedure proc
 143   end type parent
 144   type,extends(parent) :: child
 145   contains
 146     !ERROR: Procedure binding 'proc' with no dummy arguments must have NOPASS attribute
 147     procedure proc
 148   end type child
 149 contains
 150   subroutine proc
 151   end subroutine
 152 end module m2
 153
 154 module m3
 155   type t
 156   contains
 157     procedure b
 158   end type
 159 contains
 160   !ERROR: Cannot use an alternate return as the passed-object dummy argument
 161   subroutine b(*)
 162     return 1
 163   end subroutine
 164 end module m3
 165
 166 module m4
 167   type t
 168   contains
 169     procedure b
 170   end type
 171 contains
 172   ! Check to see that alternate returns work with default PASS arguments
 173   subroutine b(this, *)
 174     class(t) :: this
 175     return 1
 176   end subroutine
 177 end module m4
 178
 179 module m5
 180   type t
 181   contains
 182     !ERROR: Passed-object dummy argument 'passarg' of procedure 'b' must be of type 't' but is 'INTEGER(4)'
 183     procedure, pass(passArg) ::  b
 184   end type
 185 contains
 186   subroutine b(*, passArg)
 187     integer :: passArg
 188     return 1
 189   end subroutine
 190 end module m5
 191
 192 module m6
 193   type t
 194   contains
 195     !ERROR: Passed-object dummy argument 'passarg' of procedure 'b' must be polymorphic because 't' is extensible
 196     procedure, pass(passArg) ::  b
 197   end type
 198 contains
 199   subroutine b(*, passArg)
 200     type(t) :: passArg
 201     return 1
 202   end subroutine
 203 end module m6
 204
 205 module m7
 206   type t
 207   contains
 208   ! Check to see that alternate returns work with PASS arguments
 209     procedure, pass(passArg) ::  b
 210   end type
 211 contains
 212   subroutine b(*, passArg)
 213     class(t) :: passArg
 214     return 1
 215   end subroutine
 216 end module m7
 217
 218 module m8 ! C1529 - warning only
 219   type t
 220     procedure(mysubr), pointer, nopass :: pp
 221    contains
 222     procedure, nopass :: tbp => mysubr
 223   end type
 224  contains
 225   subroutine mysubr
 226   end subroutine
 227   subroutine test
 228     type(t) a(2)
 229     !PORTABILITY: Base of NOPASS type-bound procedure reference should be scalar
 230     call a%tbp
 231     !ERROR: Base of procedure component reference must be scalar
 232     call a%pp
 233   end subroutine
 234 end module
 235
 236 module m9
 237   type t1
 238    contains
 239     procedure, public :: tbp => sub1
 240   end type
 241   type, extends(t1) :: t2
 242    contains
 243     !ERROR: A PRIVATE procedure may not override a PUBLIC procedure
 244     procedure, private :: tbp => sub2
 245   end type
 246  contains
 247   subroutine sub1(x)
 248     class(t1), intent(in) :: x
 249   end subroutine
 250   subroutine sub2(x)
 251     class(t2), intent(in) :: x
 252   end subroutine
 253 end module
 254
 255 module m10a
 256   type t1
 257    contains
 258     procedure :: tbp => sub1
 259   end type
 260  contains
 261   subroutine sub1(x)
 262     class(t1), intent(in) :: x
 263   end subroutine
 264 end module
 265 module m10b
 266   use m10a
 267   type, extends(t1) :: t2
 268    contains
 269     !ERROR: A PRIVATE procedure may not override an accessible procedure
 270     procedure, private :: tbp => sub2
 271   end type
 272  contains
 273   subroutine sub2(x)
 274     class(t2), intent(in) :: x
 275   end subroutine
 276 end module
 277
 278 program test
 279   use m1
 280   type,extends(t) :: t2
 281   end type
 282   type(t2) a
 283   call a%tbp
 284 end program