brintos

brintos / llvm-project-archived public Read only

0
0
Text · 6.2 KiB · 27097ba Raw
194 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12! Check for semantic errors in ALLOCATE statements3 4module not_iso_fortran_env5  type event_type6  end type7  type lock_type8  end type9end module10 11subroutine C948_a()12! If SOURCE= appears, the declared type of source-expr shall not be EVENT_TYPE13! or LOCK_-TYPE from the intrinsic module ISO_FORTRAN_ENV, or have a potential subobject14! component of type EVENT_TYPE or LOCK_TYPE.15  use iso_fortran_env16 17  type oktype118    type(event_type), pointer :: event19    type(lock_type), pointer :: lock20  end type21 22  type oktype223    class(oktype1), allocatable :: t1a24    type(oktype1) :: t1b25  end type26 27  type, extends(oktype1) :: oktype328    real, allocatable :: x(:)29  end type30 31  type noktype132    type(event_type), allocatable :: event33  end type34 35  type noktype236    type(event_type) :: event37  end type38 39  type noktype340    type(lock_type), allocatable :: lock41  end type42 43  type noktype444    type(lock_type) :: lock45  end type46 47  type, extends(noktype4) :: noktype548    real, allocatable :: x(:)49  end type50 51  type, extends(event_type) :: noktype652    real, allocatable :: x(:)53  end type54 55  type recursiveType56    real x(10)57    type(recursiveType), allocatable :: next58  end type59 60  type recursiveTypeNok61    real x(10)62    type(recursiveType), allocatable :: next63    type(noktype5), allocatable :: trouble64  end type65 66  ! variable with event_type or lock_type have to be coarrays67  ! 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 :: recok80  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 :: recoksrc95  class(recursiveTypeNok), allocatable :: recnoksrc[:]96 97  ! Valid constructs98  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_ENV126  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_ENV128  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_ENV130  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_ENV132  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_ENV134  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_ENV136  allocate(nokt6[*], SOURCE=nokt6src)137  !ERROR: SOURCE expression type must not be EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV138  allocate(lock[*],  SOURCE=locksrc)139  !ERROR: SOURCE expression type must not be EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV140  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_ENV142  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_ENV144  allocate(whatever[*],SOURCE=nokt5src)145end subroutine146 147 148subroutine C948_b()149  use not_iso_fortran_env !type restriction do not apply150 151  type oktype1152    type(event_type), allocatable :: event153  end type154 155  type oktype2156    type(lock_type) :: lock157  end type158 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)173end subroutine174 175module prot176  real, pointer, protected :: pp177  real, allocatable, protected :: pa178end module179subroutine prottest180  use prot181  !ERROR: Name in ALLOCATE statement is not definable182  !BECAUSE: 'pp' is protected in this scope183  allocate(pp)184  !ERROR: Name in ALLOCATE statement is not definable185  !BECAUSE: 'pa' is protected in this scope186  allocate(pa)187  !ERROR: Name in DEALLOCATE statement is not definable188  !BECAUSE: 'pp' is protected in this scope189  deallocate(pp)190  !ERROR: Name in DEALLOCATE statement is not definable191  !BECAUSE: 'pa' is protected in this scope192  deallocate(pa)193end subroutine194