flang/test/Semantics/allocate13.f90

   1 ! RUN: %S/test_errors.sh %s %t %flang_fc1
   2 ! REQUIRES: shell
   3 ! Check for semantic errors in ALLOCATE statements
   4
   5 module not_iso_fortran_env
   6   type event_type
   7   end type
   8   type lock_type
   9   end type
  10 end module
  11
  12 subroutine C948_a()
  13 ! If SOURCE= appears, the declared type of source-expr shall not be EVENT_TYPE
  14 ! or LOCK_-TYPE from the intrinsic module ISO_FORTRAN_ENV, or have a potential subobject
  15 ! component of type EVENT_TYPE or LOCK_TYPE.
  16   use iso_fortran_env
  17
  18   type oktype1
  19     type(event_type), pointer :: event
  20     type(lock_type), pointer :: lock
  21   end type
  22
  23   type oktype2
  24     class(oktype1), allocatable :: t1a
  25     type(oktype1) :: t1b
  26   end type
  27
  28   type, extends(oktype1) :: oktype3
  29     real, allocatable :: x(:)
  30   end type
  31
  32   type noktype1
  33     type(event_type), allocatable :: event
  34   end type
  35
  36   type noktype2
  37     type(event_type) :: event
  38   end type
  39
  40   type noktype3
  41     type(lock_type), allocatable :: lock
  42   end type
  43
  44   type noktype4
  45     type(lock_type) :: lock
  46   end type
  47
  48   type, extends(noktype4) :: noktype5
  49     real, allocatable :: x(:)
  50   end type
  51
  52   type, extends(event_type) :: noktype6
  53     real, allocatable :: x(:)
  54   end type
  55
  56   type recursiveType
  57     real x(10)
  58     type(recursiveType), allocatable :: next
  59   end type
  60
  61   type recursiveTypeNok
  62     real x(10)
  63     type(recursiveType), allocatable :: next
  64     type(noktype5), allocatable :: trouble
  65   end type
  66
  67   ! variable with event_type or lock_type have to be coarrays
  68   ! see C1604 and 1608.
  69   type(oktype1), allocatable :: okt1[:]
  70   class(oktype2), allocatable :: okt2(:)[:]
  71   type(oktype3), allocatable :: okt3[:]
  72   type(noktype1), allocatable :: nokt1[:]
  73   type(noktype2), allocatable :: nokt2[:]
  74   class(noktype3), allocatable :: nokt3[:]
  75   type(noktype4), allocatable :: nokt4[:]
  76   type(noktype5), allocatable :: nokt5[:]
  77   class(noktype6), allocatable :: nokt6(:)[:]
  78   type(event_type), allocatable :: event[:]
  79   type(lock_type), allocatable :: lock(:)[:]
  80   class(recursiveType), allocatable :: recok
  81   type(recursiveTypeNok), allocatable :: recnok[:]
  82   class(*), allocatable :: whatever[:]
  83
  84   type(oktype1), allocatable :: okt1src[:]
  85   class(oktype2), allocatable :: okt2src(:)[:]
  86   type(oktype3), allocatable :: okt3src[:]
  87   class(noktype1), allocatable :: nokt1src[:]
  88   type(noktype2), allocatable :: nokt2src[:]
  89   type(noktype3), allocatable :: nokt3src[:]
  90   class(noktype4), allocatable :: nokt4src[:]
  91   type(noktype5), allocatable :: nokt5src[:]
  92   class(noktype6), allocatable :: nokt6src(:)[:]
  93   type(event_type), allocatable :: eventsrc[:]
  94   type(lock_type), allocatable :: locksrc(:)[:]
  95   type(recursiveType), allocatable :: recoksrc
  96   class(recursiveTypeNok), allocatable :: recnoksrc[:]
  97
  98   ! Valid constructs
  99   allocate(okt1[*], SOURCE=okt1src)
 100   allocate(okt2[*], SOURCE=okt2src)
 101   allocate(okt3[*], SOURCE=okt3src)
 102   allocate(whatever[*], SOURCE=okt3src)
 103   allocate(recok, SOURCE=recoksrc)
 104
 105   allocate(nokt1[*])
 106   allocate(nokt2[*])
 107   allocate(nokt3[*])
 108   allocate(nokt4[*])
 109   allocate(nokt5[*])
 110   allocate(nokt6(10)[*])
 111   allocate(lock(10)[*])
 112   allocate(event[*])
 113   allocate(recnok[*])
 114
 115   allocate(nokt1[*], MOLD=nokt1src)
 116   allocate(nokt2[*], MOLD=nokt2src)
 117   allocate(nokt3[*], MOLD=nokt3src)
 118   allocate(nokt4[*], MOLD=nokt4src)
 119   allocate(nokt5[*], MOLD=nokt5src)
 120   allocate(nokt6[*], MOLD=nokt6src)
 121   allocate(lock[*],  MOLD=locksrc)
 122   allocate(event[*], MOLD=eventsrc)
 123   allocate(recnok[*],MOLD=recnoksrc)
 124   allocate(whatever[*],MOLD=nokt6src)
 125
 126   !ERROR: SOURCE expression type must not have potential subobject component of type EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV
 127   allocate(nokt1[*], SOURCE=nokt1src)
 128   !ERROR: SOURCE expression type must not have potential subobject component of type EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV
 129   allocate(nokt2[*], SOURCE=nokt2src)
 130   !ERROR: SOURCE expression type must not have potential subobject component of type EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV
 131   allocate(nokt3[*], SOURCE=nokt3src)
 132   !ERROR: SOURCE expression type must not have potential subobject component of type EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV
 133   allocate(nokt4[*], SOURCE=nokt4src)
 134   !ERROR: SOURCE expression type must not have potential subobject component of type EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV
 135   allocate(nokt5[*], SOURCE=nokt5src)
 136   !ERROR: SOURCE expression type must not have potential subobject component of type EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV
 137   allocate(nokt6[*], SOURCE=nokt6src)
 138   !ERROR: SOURCE expression type must not be EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV
 139   allocate(lock[*],  SOURCE=locksrc)
 140   !ERROR: SOURCE expression type must not be EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV
 141   allocate(event[*], SOURCE=eventsrc)
 142   !ERROR: SOURCE expression type must not have potential subobject component of type EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV
 143   allocate(recnok[*],SOURCE=recnoksrc)
 144   !ERROR: SOURCE expression type must not have potential subobject component of type EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV
 145   allocate(whatever[*],SOURCE=nokt5src)
 146 end subroutine
 147
 148
 149 subroutine C948_b()
 150   use not_iso_fortran_env !type restriction do not apply
 151
 152   type oktype1
 153     type(event_type), allocatable :: event
 154   end type
 155
 156   type oktype2
 157     type(lock_type) :: lock
 158   end type
 159
 160   type(oktype1), allocatable :: okt1[:]
 161   class(oktype2), allocatable :: okt2[:]
 162   type(event_type), allocatable :: team[:]
 163   class(lock_type), allocatable :: lock[:]
 164
 165   type(oktype1), allocatable :: okt1src[:]
 166   class(oktype2), allocatable :: okt2src[:]
 167   class(event_type), allocatable :: teamsrc[:]
 168   type(lock_type), allocatable :: locksrc[:]
 169
 170   allocate(okt1[*], SOURCE=okt1src)
 171   allocate(okt2[*], SOURCE=okt2src)
 172   allocate(team[*], SOURCE=teamsrc)
 173   allocate(lock[*], SOURCE=locksrc)
 174 end subroutine