view gcc/testsuite/gfortran.dg/associated_1.f90 @ 128:fe568345ddd5

fix CbC-example
author mir3636
date Wed, 11 Apr 2018 19:32:28 +0900
parents 04ced10e8804
children 84e7813d76e9
line wrap: on
line source

! { dg-do run }
! PR 25292: Check that the intrinsic associated works with functions returning
! pointers as arguments
program test
   real, pointer :: a, b

   nullify(a,b)
   if(associated(a,b).or.associated(a,a)) call abort()
   allocate(a)
   if(associated(b,a)) call abort()
   if (.not.associated(x(a))) call abort ()
   if (.not.associated(a, x(a))) call abort ()

   nullify(b)
   if (associated(x(b))) call abort ()
   allocate(b)
   if (associated(x(b), x(a))) call abort ()

contains

  function x(a) RESULT(b)
    real, pointer :: a,b
    b => a
  end function x

end program test