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) 11contains 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)) STOP 1 19 deallocate (a) 20 nullify(a) 21 if(associated(a,a)) STOP 2 22 allocate (a(2,1,2)) 23 b => a 24 if (.not.associated (b)) STOP 3 25 deallocate (a) 26 end subroutine test1 27 subroutine test2 () 28 integer, pointer, dimension(:, :, :) :: a, b 29 allocate (a(2,0,2)) 30 b => a 31! Associated returns false because target is present (case(iii)). 32 if (associated (b, a)) STOP 4 33 deallocate (a) 34 allocate (a(2,1,2)) 35 b => a 36 if (.not.associated (b, a)) STOP 5 37 deallocate (a) 38 end subroutine test2 39 subroutine test3 (n) 40 integer :: n 41 character(len=n), pointer, dimension(:) :: a, b 42 allocate (a(2)) 43 b => a 44! Again, with zero character length associated returns false 45! if target is present. 46 if (associated (b, a) .and. (n .eq. 0)) STOP 6 47! 48 if ((.not.associated (b, a)) .and. (n .ne. 0)) STOP 7 49 deallocate (a) 50 end subroutine test3 51end 52