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 52