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