===================================================================
*************** gfc_conv_associated (gfc_se *se, gfc_exp
gfc_se arg2se;
tree tmp2;
tree tmp;
- tree nonzero_charlen;
tree nonzero_arraylen;
gfc_ss *ss;
bool scalar;
*************** gfc_conv_associated (gfc_se *se, gfc_exp
if (arg2->expr->ts.type == BT_CLASS)
gfc_add_data_component (arg2->expr);
- nonzero_charlen = NULL_TREE;
- if (arg1->expr->ts.type == BT_CHARACTER)
- nonzero_charlen = fold_build2_loc (input_location, NE_EXPR,
- logical_type_node,
- arg1->expr->ts.u.cl->backend_decl,
- build_zero_cst
- (TREE_TYPE (arg1->expr->ts.u.cl->backend_decl)));
if (scalar)
{
/* A pointer to a scalar. */
*************** gfc_conv_associated (gfc_se *se, gfc_exp
/* If target is present zero character length pointers cannot
be associated. */
! if (nonzero_charlen != NULL_TREE)
! se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR,
! logical_type_node,
! se->expr, nonzero_charlen);
}
se->expr = convert (gfc_typenode_for_spec (&expr->ts), se->expr);
/* If target is present zero character length pointers cannot
be associated. */
! if (arg1->expr->ts.type == BT_CHARACTER)
! {
! tmp = arg1se.string_length;
! tmp = fold_build2_loc (input_location, NE_EXPR,
! logical_type_node, tmp,
! build_zero_cst (TREE_TYPE (tmp)));
! se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR,
! logical_type_node, se->expr, tmp);
! }
}
se->expr = convert (gfc_typenode_for_spec (&expr->ts), se->expr);
===================================================================
***************
+ ! { dg-do run }
+ !
+ ! Test the fix for PR92959, where compilation of ASSOCIATED segfaulted in 's1' and 's2'.
+ !
+ ! Contributed by Gerhard Steinmetz <gscfq@t-online.de>
+ !
+ program p
+ character(:), pointer :: x, y => NULL()
+ character, pointer :: u, v => NULL ()
+ character(4), target :: tgt = "abcd"
+
+ ! Manifestly not associated
+ x => tgt
+ u => tgt(1:1)
+ call s1 (.false., 1)
+ call s2 (.false., 2)
+ ! Manifestly associated
+ y => x
+ v => u
+ call s1 (.true., 3)
+ call s2 (.true., 4)
+ ! Zero sized storage sequences must give a false.
+ y => tgt(1:0)
+ x => y
+ call s1 (.false., 5)
+ contains
+ subroutine s1 (state, err_no)
+ logical :: state
+ integer :: err_no
+ if (associated(x, y) .neqv. state) stop err_no
+ end
+ subroutine s2 (state, err_no)
+ logical :: state
+ integer :: err_no
+ if (associated(u, v) .neqv. state) stop err_no
+ end
+ end
This is a another case of the gotcha's that come from trying to use ts.u.cl->backend_decl directly, where deferred length and even, in this case fixed length characters are concerned. The fix is to make use of the string length obtained from evaluation of the expression. Regtested on FC31/x86_64 - OK for trunk? Paul 2020-02-29 Paul Thomas <pault@gcc.gnu.org> PR fortran/92959 * trans-intrinsic.c (gfc_conv_associated): Eliminate 'nonzero_charlen' and move the chunk to evaluate zero character length until after the argument evaluation so that the string length can be used. 2020-02-29 Paul Thomas <pault@gcc.gnu.org> PR fortran/92959 * gfortran.dg/associated_8.f90 : New test.