From f5b854f2307ead678a7a3b77a607b1e6ff5bd631 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sat, 27 May 2006 05:16:57 +0000 Subject: [PATCH] trans-intrinsic.c (gfc_conv_associated): If pointer in first arguments has zero array length of zero string length... 2006-05-27 Paul Thomas * trans-intrinsic.c (gfc_conv_associated): If pointer in first arguments has zero array length of zero string length, return false. 2006-05-27 Paul Thomas * gfortran.dg/associated_2.f90: New test. From-SVN: r114149 --- gcc/fortran/ChangeLog | 6 ++++ gcc/fortran/trans-intrinsic.c | 26 +++++++++++++++ gcc/testsuite/ChangeLog | 4 +++ gcc/testsuite/gfortran.dg/associated_2.f90 | 38 ++++++++++++++++++++++ 4 files changed, 74 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/associated_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e4e2db25721..187831137f0 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2006-05-27 Paul Thomas + + * trans-intrinsic.c (gfc_conv_associated): If pointer in first + arguments has zero array length of zero string length, return + false. + 2006-05-26 Francois-Xavier Coudert PR fortran/27524 diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 1d1858ca807..5db166b83d3 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -2813,6 +2813,8 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) tree tmp2; tree tmp; tree args, fndecl; + tree nonzero_charlen; + tree nonzero_arraylen; gfc_ss *ss1, *ss2; gfc_init_se (&arg1se, NULL); @@ -2821,6 +2823,23 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) 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. */ @@ -2874,6 +2893,13 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) 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); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4910f76c3e6..83b4d760b42 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2006-05-27 Paul Thomas + + * gfortran.dg/associated_2.f90: New test. + 2006-05-26 Francois-Xavier Coudert PR fortran/27524 diff --git a/gcc/testsuite/gfortran.dg/associated_2.f90 b/gcc/testsuite/gfortran.dg/associated_2.f90 new file mode 100644 index 00000000000..7ef955f0db6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associated_2.f90 @@ -0,0 +1,38 @@ +! { 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 +! + 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