gcc/testsuite/gfortran.dg/allocate_stat_3.f90

   1 ! { dg-do compile }
   2 ! PR fortran/101564 - ICE in resolve_allocate_deallocate
   3
   4 program p
   5   implicit none
   6   integer, allocatable :: x(:)
   7   integer              :: stat
   8   integer, pointer     :: A
   9   integer, target      :: ptr
  10   real,    target      :: r
  11   character(80)        :: c
  12   type t
  13      integer :: stat
  14      real    :: r
  15      complex :: z
  16   end type t
  17   type(t), allocatable :: y
  18   type tc
  19      character(len=:), allocatable :: s
  20   end type tc
  21   type(tc) :: z
  22   allocate (character(42) :: z%s, stat=stat)
  23   allocate (x(2), stat=stat)
  24   deallocate (x,  stat=stat)
  25   allocate (A,    stat=f())
  26   deallocate (A,  stat=f())
  27   allocate (A,    stat=y%stat)
  28   deallocate (A,  stat=y%stat)
  29   allocate (A,    stat=stat, errmsg=c(2:79))
  30   deallocate (A,  stat=stat, errmsg=c(2:79))
  31   allocate (A,    stat=stat, errmsg=z%s)
  32   deallocate (A,  stat=stat, errmsg=z%s)
  33   allocate (A,    stat=stat, errmsg=z%s(2:39))
  34   deallocate (A,  stat=stat, errmsg=z%s(2:39))
  35   allocate (A,    stat=y%r)  ! { dg-error "must be a scalar INTEGER variable" }
  36   deallocate (A,  stat=y%r)  ! { dg-error "must be a scalar INTEGER variable" }
  37   allocate (x(2), stat=stat%kind) ! { dg-error "STAT tag" }
  38   deallocate (x,  stat=stat%kind) ! { dg-error "STAT variable" }
  39   allocate (A,    stat=A%kind)    ! { dg-error "STAT tag" }
  40   deallocate (A,  stat=A%kind)    ! { dg-error "STAT variable" }
  41   allocate (A,    stat=c%len)     ! { dg-error "STAT tag" }
  42   deallocate (A,  stat=c%len)     ! { dg-error "STAT variable" }
  43   allocate (A,    stat=y%stat%kind) ! { dg-error "STAT tag" }
  44   deallocate (A,  stat=y%stat%kind) ! { dg-error "STAT variable" }
  45   allocate (y, stat=y%stat) ! { dg-error "within the same ALLOCATE statement" }
  46   allocate (y, stat=r)      ! { dg-error "must be a scalar INTEGER variable" }
  47   allocate (A, stat=y%z%re)   ! { dg-error "must be a scalar INTEGER variable" }
  48   deallocate (A, stat=y%z%im) ! { dg-error "must be a scalar INTEGER variable" }
  49   allocate (y, stat=g())    ! { dg-error "must be a scalar INTEGER variable" }
  50   deallocate (y, stat=g())  ! { dg-error "must be a scalar INTEGER variable" }
  51   allocate (A, stat=f)      ! { dg-error "requires an argument list" }
  52   deallocate (A, stat=f)    ! { dg-error "requires an argument list" }
  53   allocate (y, stat=g)      ! { dg-error "requires an argument list" }
  54   deallocate (y, stat=g)    ! { dg-error "requires an argument list" }
  55   allocate (A, stat=z%s%len)   ! { dg-error "parameter inquiry" }
  56   deallocate (A, stat=z%s%len) ! { dg-error "parameter inquiry" }
  57   allocate (A,   stat=f(), errmsg="") ! { dg-error "ERRMSG variable" }
  58   deallocate (A, stat=f(), errmsg="") ! { dg-error "ERRMSG variable" }
  59   allocate (A,   stat=stat, errmsg=z%s%len) ! { dg-error "ERRMSG variable" }
  60   deallocate (A, stat=stat, errmsg=z%s%len) ! { dg-error "ERRMSG variable" }
  61   deallocate (z%s, stat=stat, errmsg=z%s)   ! { dg-error "within the same DEALLOCATE statement" }
  62 contains
  63   integer function f()
  64     pointer :: f
  65     f => ptr
  66   end function f
  67   real function g()
  68     pointer :: g
  69     g => r
  70   end function g
  71 end