tree tmp2;
tree tmp;
tree args, fndecl;
+ tree nonzero_charlen;
+ tree nonzero_arraylen;
gfc_ss *ss1, *ss2;
gfc_init_se (&arg1se, NULL);
arg2 = arg1->next;
ss1 = gfc_walk_expr (arg1->expr);
+ nonzero_charlen = NULL_TREE;
+ if (arg1->expr->ts.type == BT_CHARACTER)
+ nonzero_charlen = build2 (NE_EXPR, boolean_type_node,
+ arg1->expr->ts.cl->backend_decl,
+ integer_zero_node);
+
+ nonzero_arraylen = NULL_TREE;
+ if (ss1 != gfc_ss_terminator)
+ {
+ arg1se.descriptor_only = 1;
+ gfc_conv_expr_lhs (&arg1se, arg1->expr);
+ tmp = gfc_conv_descriptor_stride (arg1se.expr,
+ gfc_rank_cst[arg1->expr->rank - 1]);
+ nonzero_arraylen = build2 (NE_EXPR, boolean_type_node,
+ tmp, integer_zero_node);
+ }
+
if (!arg2->expr)
{
/* No optional target. */
se->expr = build_function_call_expr (fndecl, args);
}
}
+
+ if (nonzero_charlen != NULL_TREE)
+ se->expr = build2 (TRUTH_AND_EXPR, boolean_type_node,
+ se->expr, nonzero_charlen);
+ if (nonzero_arraylen != NULL_TREE)
+ se->expr = build2 (TRUTH_AND_EXPR, boolean_type_node,
+ se->expr, nonzero_arraylen);
se->expr = convert (gfc_typenode_for_spec (&expr->ts), se->expr);
}
--- /dev/null
+! { dg-do run }
+! Tests the implementation of 13.14.13 of the f95 standard
+! in respect of zero character and zero array length.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!
+ call test1 ()
+ call test2 ()
+ call test3 (0)
+ call test3 (1)
+contains
+ subroutine test1 ()
+ integer, pointer, dimension(:, :, :) :: a, b
+ allocate (a(2,0,2))
+ b => a
+ if (associated (b)) call abort ()
+ allocate (a(2,1,2))
+ b => a
+ if (.not.associated (b)) call abort ()
+ end subroutine test1
+ subroutine test2 ()
+ integer, pointer, dimension(:, :, :) :: a, b
+ allocate (a(2,0,2))
+ b => a
+ if (associated (b, a)) call abort ()
+ allocate (a(2,1,2))
+ b => a
+ if (.not.associated (b, a)) call abort ()
+ end subroutine test2
+ subroutine test3 (n)
+ integer :: n
+ character(len=n), pointer, dimension(:) :: a, b
+ allocate (a(2))
+ b => a
+ if (associated (b, a) .and. (n .eq. 0)) call abort ()
+ if ((.not.associated (b, a)) .and. (n .ne. 0)) call abort ()
+ end subroutine test3
+end
\ No newline at end of file