gcc/testsuite/gfortran.dg/associated_2.f90

   1 ! { dg-do run }
   2 ! Tests the implementation of 13.14.13 of the f95 standard
   3 ! in respect of zero character and zero array length.
   4 !
   5 ! Contributed by Paul Thomas  <pault@gcc.gnu.org>
   6 !
   7   call test1 ()
   8   call test2 ()
   9   call test3 (0)
  10   call test3 (1)
  11 contains
  12   subroutine test1 ()
  13     integer, pointer, dimension(:, :, :)  :: a, b
  14     allocate (a(2,0,2))
  15     b => a
  16 ! Even though b is zero length, associated returns true because
  17 ! the target argument is not present (case (i))
  18     if (.not. associated (b)) call abort ()
  19     deallocate (a)
  20     allocate (a(2,1,2))
  21     b => a
  22     if (.not.associated (b)) call abort ()
  23     deallocate (a)
  24   end subroutine test1
  25   subroutine test2 ()
  26     integer, pointer, dimension(:, :, :)  :: a, b
  27     allocate (a(2,0,2))
  28     b => a
  29 ! Associated returns false because target is present (case(iii)).
  30     if (associated (b, a)) call abort ()
  31     deallocate (a)
  32     allocate (a(2,1,2))
  33     b => a
  34     if (.not.associated (b, a)) call abort ()
  35     deallocate (a)
  36   end subroutine test2
  37   subroutine test3 (n)
  38     integer :: n
  39     character(len=n), pointer, dimension(:)  :: a, b
  40     allocate (a(2))
  41     b => a
  42 ! Again, with zero character length associated returns false
  43 ! if target is present.
  44     if (associated (b, a) .and. (n .eq. 0)) call abort ()
  45 !
  46     if ((.not.associated (b, a))  .and. (n .ne. 0)) call abort ()
  47     deallocate (a)
  48   end subroutine test3
  49 end