flang/test/Semantics/allocate13.f90

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