1! RUN: %S/test_errors.sh %s %t %f18 2! Check for semantic errors in ALLOCATE statements 3 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 each 7! allocate-object is type compatible. 8 9!second part C945, specific to SOURCE, is not checked here. 10 11 type A 12 integer i 13 end type 14 15 type, extends(A) :: B 16 real, allocatable :: x(:) 17 end type 18 19 type, extends(B) :: C 20 character(5) s 21 end type 22 23 type Unrelated 24 class(A), allocatable :: polymorph 25 type(A), allocatable :: notpolymorph 26 end type 27 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 :: unrelat 43 44 allocate(x1, source=srcx) 45 allocate(x2, mold=srcx2) 46 allocate(bp2(3)%x, source=srcx2) 47 !OK, type-compatible with A 48 allocate(aa1, up1, unrelat%polymorph, unrelat%notpolymorph, & 49 npaa1, source=srca) 50 allocate(aa2, up2, npaa2, source=srca2) 51 !OK, type compatible with B 52 allocate(aa1, up1, unrelat%polymorph, bp1, npbp1, mold=srcb) 53 allocate(aa2, up2, bp2, npbp2, mold=srcb2) 54 !OK, type compatible with C 55 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 SOURCE 60 allocate(x1, mold=src_complex) 61 !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE 62 allocate(x2(2), source=src_complex2) 63 !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE 64 allocate(bp2(3)%x, mold=src_logical) 65 !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE 66 allocate(unrelat, mold=srca) 67 !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE 68 allocate(unrelat%notpolymorph, source=srcb) 69 !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE 70 allocate(npaa1, mold=srcb) 71 !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE 72 allocate(npaa2, source=srcb2) 73 !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE 74 allocate(npca1, bp1, npbp1, mold=srcc) 75end subroutine 76 77module m 78 type :: t 79 real x(100) 80 contains 81 procedure :: f 82 end type 83 contains 84 function f(this) result (x) 85 class(t) :: this 86 class(t), allocatable :: x 87 end function 88 subroutine bar 89 type(t) :: o 90 type(t), allocatable :: p 91 real, allocatable :: rp 92 allocate(p, source=o%f()) 93 !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE 94 allocate(rp, source=o%f()) 95 end subroutine 96end module 97 98! Related to C945, check typeless expression are caught 99 100subroutine sub 101end subroutine 102 103function func() result(x) 104 real :: x 105end function 106 107program test_typeless 108 class(*), allocatable :: x 109 interface 110 subroutine sub 111 end subroutine 112 real function func() 113 end function 114 end interface 115 procedure (sub), pointer :: subp => sub 116 procedure (func), pointer :: funcp => func 117 118 ! OK 119 allocate(x, mold=func()) 120 allocate(x, source=funcp()) 121 122 !ERROR: Typeless item not allowed as SOURCE or MOLD in ALLOCATE 123 allocate(x, mold=x'1') 124 !ERROR: Typeless item not allowed as SOURCE or MOLD in ALLOCATE 125 allocate(x, mold=sub) 126 !ERROR: Typeless item not allowed as SOURCE or MOLD in ALLOCATE 127 allocate(x, source=subp) 128 !ERROR: Typeless item not allowed as SOURCE or MOLD in ALLOCATE 129 allocate(x, mold=func) 130 !ERROR: Typeless item not allowed as SOURCE or MOLD in ALLOCATE 131 allocate(x, source=funcp) 132end program 133