gcc/testsuite/gfortran.dg/cray_pointers_1.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-fcray-pointer" }
   3
   4 ! Bad type for pointer
   5 subroutine err1
   6   real ipt
   7   real array(10)
   8   pointer (ipt, array) ! { dg-error "integer" }
   9 end subroutine err1
  10
  11 ! Multiple declarations for the same pointee
  12 subroutine err2
  13   real array(10)
  14   pointer (ipt1, array)
  15   pointer (ipt2, array) ! { dg-error "multiple" }
  16 end subroutine err2
  17
  18 ! Vector assignment to an assumed size array
  19 subroutine err3
  20   real target(10)
  21   real array(*)
  22   pointer (ipt, array)
  23   ipt = loc (target)
  24   array = 0    ! { dg-error "upper bound in the last dimension" }
  25 end subroutine err3
  26
  27 subroutine err4
  28   pointer (ipt, ipt) ! { dg-error "POINTER attribute" }
  29 end subroutine err4
  30
  31 ! duplicate array specs
  32 subroutine err5
  33   pointer (ipt, array(7))
  34   real array(10)      ! { dg-error "Duplicate array" }
  35 end subroutine err5
  36
  37 subroutine err6
  38   real array(10)
  39   pointer (ipt, array(7))  ! { dg-error "Duplicate array" }
  40 end subroutine err6
  41
  42 ! parsing stuff
  43 subroutine err7
  44   pointer (                  ! { dg-error "variable name" }
  45   pointer (ipt               ! { dg-error "Expected" }
  46   pointer (ipt,              ! { dg-error "variable name" }
  47   pointer (ipt,a1            ! { dg-error "Expected" }
  48   pointer (ipt,a2),          ! { dg-error "Expected" }
  49   pointer (ipt,a3),(         ! { dg-error "variable name" }
  50   pointer (ipt,a4),(ipt2     ! { dg-error "Expected" }
  51   pointer (ipt,a5),(ipt2,    ! { dg-error "variable name" }
  52   pointer (ipt,a6),(ipt2,a7  ! { dg-error "Expected" }
  53 end subroutine err7
  54
  55 ! more attributes
  56 subroutine err8(array)
  57   real array(10)
  58   integer dim(2)
  59   integer, pointer :: f90ptr
  60   integer, target :: f90targ
  61   pointer (ipt, array)    ! { dg-error "DUMMY" }
  62   pointer (dim, elt1)     ! { dg-error "DIMENSION" }
  63   pointer (f90ptr, elt2)  ! { dg-error "POINTER" }
  64   pointer (ipt, f90ptr)   ! { dg-error "POINTER" }
  65   pointer (f90targ, elt3) ! { dg-error "TARGET" }
  66   pointer (ipt, f90targ)  ! { dg-error "TARGET" }
  67 end subroutine err8
  68