gcc/testsuite/gfortran.dg/PR49268.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fcray-pointer" }
   3
   4 ! Test the fix for a runtime error
   5 ! Contributed by Mike Kumbera <kumbera1@llnl.gov>
   6
   7         program bob
   8         implicit none
   9         integer*8 ipfoo
  10         integer n,m,i,j
  11         real*8 foo
  12
  13         common /ipdata/ ipfoo
  14         common /ipsize/ n,m
  15         POINTER ( ipfoo, foo(3,7) )
  16
  17         n=3
  18         m=7
  19
  20         ipfoo=malloc(8*n*m)
  21         do i=1,n
  22             do j=1,m
  23                 foo(i,j)=1.d0
  24             end do
  25         end do
  26         call use_foo()
  27         end  program bob
  28
  29
  30         subroutine use_foo()
  31         implicit none
  32         integer n,m,i,j
  33         integer*8 ipfoo
  34         common /ipdata/ ipfoo
  35         common /ipsize/ n,m
  36         real*8 foo,boo
  37
  38         !fails if * is the last dimension
  39         POINTER ( ipfoo, foo(n,*) )
  40
  41         !works if the last dimension is specified
  42         !POINTER ( ipfoo, foo(n,m) )
  43         boo=0.d0
  44         do i=1,n
  45             do j=1,m
  46                boo=foo(i,j)+1.0
  47                if (abs (boo - 2.0) .gt. 1e-6) call abort
  48             end do
  49         end do
  50
  51         end subroutine use_foo