flang/test/Semantics/resolve105.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Test instantiation of components that are procedure pointers.
   3 !
   4 program test
   5   type dtype(kindParam)
   6     integer, kind :: kindParam = 4
   7     !ERROR: KIND parameter value (66) of intrinsic type REAL did not resolve to a supported value
   8     !ERROR: KIND parameter value (55) of intrinsic type REAL did not resolve to a supported value
   9     procedure (real(kindParam)), pointer, nopass :: field => null()
  10   end type
  11
  12   type base(kindParam)
  13     integer, kind :: kindParam = 4
  14     !ERROR: KIND parameter value (77) of intrinsic type REAL did not resolve to a supported value
  15     procedure (real(kindParam)), pointer, nopass :: field => null()
  16   end type
  17   type dependentType(kindParam)
  18     integer, kind :: kindParam = 4
  19     procedure (type(base(kindParam))), pointer, nopass :: field => null()
  20   end type
  21
  22   ! OK unless entities are declared with the default type
  23   type badDefaultType(kindParam)
  24     integer, kind :: kindParam = 99
  25     !ERROR: KIND parameter value (99) of intrinsic type REAL did not resolve to a supported value
  26     !ERROR: KIND parameter value (44) of intrinsic type REAL did not resolve to a supported value
  27     procedure (real(kindParam)), pointer, nopass :: field => null()
  28   end type
  29
  30   type parent(kindParam)
  31     integer, kind :: kindParam = 4
  32     !ERROR: KIND parameter value (33) of intrinsic type REAL did not resolve to a supported value
  33     !ERROR: KIND parameter value (88) of intrinsic type REAL did not resolve to a supported value
  34     procedure (real(kindParam)), pointer, nopass :: parentField => null()
  35   end type
  36   type, extends(parent) :: child
  37     integer :: field
  38   end type child
  39 contains
  40   subroutine testGoodDefault(arg)
  41     type(dtype) :: arg
  42     if (associated(arg%field)) stop 'fail'
  43   end subroutine testGoodDefault
  44
  45   subroutine testStar(arg)
  46     type(dtype(*)),intent(inout) :: arg
  47     if (associated(arg%field)) stop 'fail'
  48   end subroutine testStar
  49
  50   subroutine testBadDeclaration(arg)
  51     type(dtype(66)) :: arg
  52     if (associated(arg%field)) stop 'fail'
  53   end subroutine testBadDeclaration
  54
  55   subroutine testBadLocalDeclaration()
  56     type(dtype(55)) :: local
  57     if (associated(local%field)) stop 'fail'
  58   end subroutine testBadLocalDeclaration
  59
  60   subroutine testDependent()
  61     type(dependentType(77)) :: local
  62   end subroutine testDependent
  63
  64   subroutine testBadDefault()
  65     type(badDefaultType) :: local
  66   end subroutine testBadDefault
  67
  68   subroutine testBadDefaultWithBadDeclaration()
  69     type(badDefaultType(44)) :: local
  70   end subroutine testBadDefaultWithBadDeclaration
  71
  72   subroutine testBadDefaultWithGoodDeclaration()
  73     type(badDefaultType(4)) :: local
  74   end subroutine testBadDefaultWithGoodDeclaration
  75
  76   subroutine testExtended()
  77     type(child(33)) :: local1
  78     type(child(4)) :: local2
  79     type(parent(88)) :: local3
  80     type(parent(8)) :: local4
  81   end subroutine testExtended
  82 end program test