flang/test/Semantics/allocate07.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Check for semantic errors in ALLOCATE statements
   3
   4 subroutine C936(param_ca_4_assumed, param_ta_4_assumed, param_ca_4_deferred)
   5 ! If type-spec appears, the kind type parameter values of each
   6 ! allocate-object shall be the same as the corresponding type
   7 ! parameter values of the type-spec.
   8
   9   real(kind=4), allocatable :: x1, x2(:)
  10
  11   type WithParam(k1, l1)
  12     integer, kind :: k1=1
  13     integer, len :: l1=2
  14   end type
  15
  16   type, extends(WithParam) :: WithParamExtent(k2, l2)
  17     integer, kind :: k2
  18     integer, len :: l2
  19   end type
  20
  21   type, extends(WithParamExtent) :: WithParamExtent2(k3, l3)
  22     integer, kind :: k3 = 8
  23     integer, len :: l3
  24   end type
  25
  26   type(WithParam(4, 2)), allocatable :: param_ta_4_2
  27   class(WithParam(4, 2)), pointer :: param_ca_4_2
  28
  29   type(WithParam(4, *)), pointer :: param_ta_4_assumed
  30   class(WithParam(4, *)), allocatable :: param_ca_4_assumed
  31
  32   type(WithParam(4, :)), allocatable :: param_ta_4_deferred
  33   class(WithParam(4, :)), pointer :: param_ca_4_deferred
  34   class(WithParam), allocatable :: param_defaulted
  35
  36   type(WithParamExtent2(k1=4, l1=:, k2=5, l2=:, l3=8 )), pointer :: extended2
  37
  38   class(*), pointer :: whatever
  39
  40   character(:), allocatable :: deferredChar
  41   character(2), allocatable :: char2
  42
  43   ! Nominal test cases
  44   allocate(real(kind=4):: x1, x2(10))
  45   allocate(WithParam(4, 2):: param_ta_4_2, param_ca_4_2)
  46   allocate(WithParamExtent(4, 2, 8, 3):: param_ca_4_2)
  47   allocate(WithParam(4, *):: param_ta_4_assumed, param_ca_4_assumed)
  48   allocate(WithParamExtent(4, *, 8, 3):: param_ca_4_assumed)
  49   allocate(WithParam(4, 2):: param_ta_4_deferred, param_ca_4_deferred)
  50   allocate(WithParamExtent(4, 2, 8, 3):: param_ca_4_deferred)
  51   allocate(WithParamExtent2(k1=4, l1=5, k2=5, l2=6, l3=8 ):: extended2)
  52   allocate(WithParamExtent2(k1=4, l1=2, k2=5, l2=6, k3=5, l3=8 ):: param_ca_4_2)
  53   allocate(WithParam:: param_defaulted)
  54   allocate(WithParam(k1=1, l1=2):: param_defaulted)
  55   allocate(WithParam(k1=1):: param_defaulted)
  56   allocate(WithParamExtent2(k1=1, l1=2, k2=5, l2=6, k3=5, l3=8 ):: param_defaulted)
  57   allocate(WithParamExtent2(k1=1, l1=2, k2=5, l2=6, k3=5, l3=8 ):: whatever)
  58   allocate(character(len=1):: deferredChar)
  59   allocate(character(len=2):: char2)
  60
  61   !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
  62   allocate(real(kind=8):: x1)
  63   !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
  64   allocate(real(kind=8):: x2(10))
  65   !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
  66   allocate(WithParam(8, 2):: param_ta_4_2)
  67   !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
  68   allocate(WithParam(8, 2):: param_ca_4_2)
  69   !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
  70   allocate(WithParamExtent(8, 2, 8, 3):: param_ca_4_2)
  71   !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
  72   allocate(WithParam(8, *):: param_ta_4_assumed)
  73   !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
  74   allocate(WithParam(8, *):: param_ca_4_assumed)
  75   !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
  76   allocate(WithParamExtent(8, *, 8, 3):: param_ca_4_assumed)
  77   !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
  78   allocate(WithParam(8, 2):: param_ta_4_deferred)
  79   !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
  80   allocate(WithParam(8, 2):: param_ca_4_deferred)
  81   !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
  82   allocate(WithParamExtent(8, 2, 8, 3):: param_ca_4_deferred)
  83   !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
  84   allocate(WithParamExtent2(k1=5, l1=5, k2=5, l2=6, l3=8 ):: extended2)
  85   !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
  86   allocate(WithParamExtent2(k1=5, l1=2, k2=5, l2=6, k3=5, l3=8 ):: param_ca_4_2)
  87   !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
  88   allocate(WithParamExtent2(k1=4, l1=5, k2=5, l2=6, k3=5, l3=8 ):: extended2)
  89   !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
  90   allocate(WithParam:: param_ca_4_2)
  91   !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
  92   allocate(WithParam(k1=2, l1=2):: param_defaulted)
  93   !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
  94   allocate(WithParam(k1=2):: param_defaulted)
  95   !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
  96   allocate(WithParamExtent2(k1=5, l1=2, k2=5, l2=6, k3=5, l3=8 ):: param_defaulted)
  97
  98   !ERROR: Either type-spec or source-expr must appear in ALLOCATE when allocatable object has a deferred type parameters
  99   allocate(deferredChar)
 100   !ERROR: Character length of allocatable object in ALLOCATE must be the same as the type-spec
 101   allocate(character(len=1):: char2)
 102
 103 end subroutine