169 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12! Check for semantic errors in ALLOCATE statements3 4subroutine C945_a(srca, srcb, srcc, src_complex, src_logical, &5 srca2, srcb2, srcc2, src_complex2, srcx, srcx2)6! If type-spec appears, it shall specify a type with which each7! allocate-object is type compatible.8 9!second part C945, specific to SOURCE, is not checked here.10 11 type A12 integer i13 end type14 15 type, extends(A) :: B16 real, allocatable :: x(:)17 end type18 19 type, extends(B) :: C20 character(5) s21 end type22 23 type Unrelated24 class(A), allocatable :: polymorph25 type(A), allocatable :: notpolymorph26 end type27 28 real srcx, srcx2(6)29 class(A) srca, srca2(5)30 type(B) srcb, srcb2(6)31 class(C) srcc, srcc2(7)32 complex src_complex, src_complex2(8)33 complex src_logical(5)34 real, allocatable :: x1, x2(:)35 class(A), allocatable :: aa1, aa2(:)36 class(B), pointer :: bp1, bp2(:)37 class(C), allocatable :: ca1, ca2(:)38 class(*), pointer :: up1, up2(:)39 type(A), allocatable :: npaa1, npaa2(:)40 type(B), pointer :: npbp1, npbp2(:)41 type(C), allocatable :: npca1, npca2(:)42 class(Unrelated), allocatable :: unrelat43 44 allocate(x1, source=srcx)45 allocate(x2, mold=srcx2)46 allocate(bp2(3)%x, source=srcx2)47 !OK, type-compatible with A48 allocate(aa1, up1, unrelat%polymorph, unrelat%notpolymorph, &49 npaa1, source=srca)50 allocate(aa2, up2, npaa2, source=srca2)51 !OK, type compatible with B52 allocate(aa1, up1, unrelat%polymorph, bp1, npbp1, mold=srcb)53 allocate(aa2, up2, bp2, npbp2, mold=srcb2)54 !OK, type compatible with C55 allocate(aa1, up1, unrelat%polymorph, bp1, ca1, npca1, mold=srcc)56 allocate(aa2, up2, bp2, ca2, npca2, source=srcc2)57 58 59 !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE60 allocate(x1, mold=src_complex)61 !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE62 allocate(x2(2), source=src_complex2)63 !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE64 allocate(bp2(3)%x, mold=src_logical)65 !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE66 allocate(unrelat, mold=srca)67 !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE68 allocate(unrelat%notpolymorph, source=srcb)69 !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE70 allocate(npaa1, mold=srcb)71 !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE72 allocate(npaa2, source=srcb2)73 !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE74 allocate(npca1, bp1, npbp1, mold=srcc)75end subroutine76 77module m78 type :: t79 real x(100)80 contains81 procedure :: f82 end type83 contains84 function f(this) result (x)85 class(t) :: this86 class(t), allocatable :: x87 end function88 subroutine bar89 type(t) :: o90 type(t), allocatable :: p91 real, allocatable :: rp92 allocate(p, source=o%f())93 !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE94 allocate(rp, source=o%f())95 end subroutine96end module97 98module mod199 type, bind(C) :: t100 integer :: n101 end type102 type(t), allocatable :: x103end104 105module mod2106 type, bind(C) :: t107 integer :: n108 end type109 type(t), allocatable :: x110end111 112module mod3113 type, bind(C) :: t114 real :: a115 end type116 type(t), allocatable :: x117end118 119subroutine same_type120 use mod1, only: a => x121 use mod2, only: b => x122 use mod3, only: c => x123 allocate(a)124 allocate(b, source=a) ! ok125 deallocate(a)126 allocate(a, source=b) ! ok127 !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE128 allocate(c, source=a)129 deallocate(a)130 !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE131 allocate(a, source=c)132end133 134! Related to C945, check typeless expression are caught135 136subroutine sub137end subroutine138 139function func() result(x)140 real :: x141end function142 143program test_typeless144 class(*), allocatable :: x145 interface146 subroutine sub147 end subroutine148 real function func()149 end function150 end interface151 procedure (sub), pointer :: subp => sub152 procedure (func), pointer :: funcp => func153 154 ! OK155 allocate(x, mold=func())156 allocate(x, source=funcp())157 158 !ERROR: Typeless item not allowed as SOURCE or MOLD in ALLOCATE159 allocate(x, mold=x'1')160 !ERROR: Typeless item not allowed as SOURCE or MOLD in ALLOCATE161 allocate(x, mold=sub)162 !ERROR: Typeless item not allowed as SOURCE or MOLD in ALLOCATE163 allocate(x, source=subp)164 !ERROR: Typeless item not allowed as SOURCE or MOLD in ALLOCATE165 allocate(x, mold=func)166 !ERROR: Typeless item not allowed as SOURCE or MOLD in ALLOCATE167 allocate(x, source=funcp)168end program169