OSDN Git Service

64cf2b30ccb06519c2cd91d6e19efbfeb4929415
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / associated_1.f90
1 ! { dg-do run }
2 ! PR 25292: Check that the intrinsic associated works with functions returning
3 ! pointers as arguments
4 program test
5    real, pointer :: a, b
6
7    allocate(a)
8    if (.not.associated(x(a))) call abort ()
9    if (.not.associated(a, x(a))) call abort ()
10
11    nullify(b)
12    if (associated(x(b))) call abort ()
13    allocate(b)
14    if (associated(x(b), x(a))) call abort ()
15
16 contains
17
18   function x(a) RESULT(b)
19     real, pointer :: a,b
20     b => a
21   end function x
22
23 end program test