flang/test/Semantics/allocate04.f90

   1 ! RUN: %S/test_errors.sh %s %t %flang_fc1
   2 ! REQUIRES: shell
   3 ! Check for semantic errors in ALLOCATE statements
   4
   5
   6 subroutine C933_b(n)
   7 ! If any allocate-object has a deferred type parameter, is unlimited polymorphic,
   8 ! or is of abstract type, either type-spec or source-expr shall appear.
   9
  10 ! only testing unlimited polymorphic and abstract-type here
  11
  12   type, abstract :: Base
  13     integer x
  14   end type
  15
  16   type, extends(Base) :: A
  17     integer y
  18   end type
  19
  20   type, extends(Base) :: B
  21     class(Base), allocatable :: y
  22   end type
  23
  24   type C
  25     class(*), pointer :: whatever
  26     real, pointer :: y
  27   end type
  28
  29   integer n
  30   class(*), allocatable :: u1, u2(:)
  31   class(C), allocatable :: n1, n2(:)
  32   class(Base), pointer :: p1, p2(:)
  33   class(B), pointer :: p3, p4(:)
  34   type(A) :: molda = A(1, 2)
  35
  36   !ERROR: Either type-spec or source-expr must appear in ALLOCATE when allocatable object is unlimited polymorphic
  37   allocate(u1)
  38   !ERROR: Either type-spec or source-expr must appear in ALLOCATE when allocatable object is unlimited polymorphic
  39   allocate(u2(2))
  40   !ERROR: Either type-spec or source-expr must appear in ALLOCATE when allocatable object is unlimited polymorphic
  41   allocate(n1%whatever)
  42   !ERROR: Either type-spec or source-expr must appear in ALLOCATE when allocatable object is unlimited polymorphic
  43   allocate(n2(2)%whatever)
  44   !ERROR: Either type-spec or source-expr must appear in ALLOCATE when allocatable object is of abstract type
  45   allocate(p1)
  46   !ERROR: Either type-spec or source-expr must appear in ALLOCATE when allocatable object is of abstract type
  47   allocate(p2(2))
  48   !ERROR: Either type-spec or source-expr must appear in ALLOCATE when allocatable object is of abstract type
  49   allocate(p3%y)
  50   !ERROR: Either type-spec or source-expr must appear in ALLOCATE when allocatable object is of abstract type
  51   allocate(p4(2)%y)
  52   !WRONG allocate(Base:: u1)
  53
  54   ! No error expected
  55   allocate(real:: u1, u2(2))
  56   allocate(A:: u1, u2(2))
  57   allocate(C:: u1, u2(2))
  58   allocate(character(n):: u1, u2(2))
  59   allocate(C:: n1%whatever, n2(2)%whatever)
  60   allocate(A:: p1, p2(2))
  61   allocate(B:: p3%y, p4(2)%y)
  62   allocate(u1, u2(2), MOLD = cos(5.+n))
  63   allocate(u1, u2(2), MOLD = molda)
  64   allocate(u1, u2(2), MOLD = n1)
  65   allocate(u1, u2(2), MOLD = new_line("a"))
  66   allocate(n1%whatever, MOLD = n2(1))
  67   allocate(p1, p2(2), MOLD = p3)
  68   allocate(p3%y, p4(2)%y, MOLD = B(5))
  69   allocate(u1, u2(2), SOURCE = cos(5.+n))
  70   allocate(u1, u2(2), SOURCE = molda)
  71   allocate(u1, u2(2), SOURCE = n1)
  72   allocate(u1, u2(2), SOURCE = new_line("a"))
  73   allocate(n1%whatever, SOURCE = n2(1))
  74   allocate(p1, p2(2), SOURCE = p3)
  75   allocate(p3%y, p4(2)%y, SOURCE = B(5))
  76
  77   ! OK, not unlimited polymorphic or abstract
  78   allocate(n1, n2(2))
  79   allocate(p3, p4(2))
  80 end subroutine