flang/test/Semantics/allocate08.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Check for semantic errors in ALLOCATE statements
   3
   4 subroutine 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)
  75 end subroutine
  76
  77 module 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
  96 end module
  97
  98 ! Related to C945, check typeless expression are caught
  99
 100 subroutine sub
 101 end subroutine
 102
 103 function func() result(x)
 104   real :: x
 105 end function
 106
 107 program 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)
 132 end program