flang/test/Semantics/assign12.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 module m
   3   type base
   4     procedure(baseSub), pointer :: baseComponent
   5   end type
   6   type, extends(base) :: extended
   7   end type
   8  contains
   9   subroutine baseSub(x)
  10     class(base), intent(in) :: x
  11   end
  12   subroutine extendedSub(x)
  13     class(extended), intent(in) :: x
  14   end
  15   subroutine baseSubmono(x)
  16     type(base), intent(in) :: x
  17   end
  18   subroutine test
  19     procedure(baseSub), pointer :: basePtr
  20     procedure(extendedSub), pointer :: extendedPtr
  21     type(extended) :: extendedVar
  22     extendedPtr => baseSub ! ok
  23     extendedPtr => basePtr ! ok
  24     extendedVar = extended(baseSub) ! ok
  25     extendedVar = extended(basePtr) ! ok
  26     !ERROR: Procedure pointer 'baseptr' associated with incompatible procedure designator 'extendedsub': incompatible dummy argument #1: incompatible dummy data object types: CLASS(extended) vs CLASS(base)
  27     basePtr => extendedSub
  28     !ERROR: Procedure pointer 'baseptr' associated with incompatible procedure designator 'extendedptr': incompatible dummy argument #1: incompatible dummy data object types: CLASS(extended) vs CLASS(base)
  29     basePtr => extendedPtr
  30     !ERROR: Procedure pointer 'basecomponent' associated with incompatible procedure designator 'extendedsub': incompatible dummy argument #1: incompatible dummy data object types: CLASS(extended) vs CLASS(base)
  31     extendedVar = extended(extendedSub)
  32     !ERROR: Procedure pointer 'basecomponent' associated with incompatible procedure designator 'extendedptr': incompatible dummy argument #1: incompatible dummy data object types: CLASS(extended) vs CLASS(base)
  33     extendedVar = extended(extendedPtr)
  34     !ERROR: Procedure pointer 'baseptr' associated with incompatible procedure designator 'basesubmono': incompatible dummy argument #1: incompatible dummy data object polymorphism: base vs CLASS(base)
  35     basePtr => baseSubmono
  36   end
  37 end