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 <[email protected]>
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 <[email protected]>
PR fortran/92959
* gfortran.dg/associated_8.f90 : New test.
Index: gcc/fortran/trans-intrinsic.c
===================================================================
*** gcc/fortran/trans-intrinsic.c (revision 279842)
--- gcc/fortran/trans-intrinsic.c (working copy)
*************** gfc_conv_associated (gfc_se *se, gfc_exp
*** 8573,8579 ****
gfc_se arg2se;
tree tmp2;
tree tmp;
- tree nonzero_charlen;
tree nonzero_arraylen;
gfc_ss *ss;
bool scalar;
--- 8573,8578 ----
*************** gfc_conv_associated (gfc_se *se, gfc_exp
*** 8629,8641 ****
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. */
--- 8628,8633 ----
*************** gfc_conv_associated (gfc_se *se, gfc_exp
*** 8705,8714 ****
/* 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);
--- 8697,8711 ----
/* 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);
Index: gcc/testsuite/gfortran.dg/associated_8.f90
===================================================================
*** gcc/testsuite/gfortran.dg/associated_8.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/associated_8.f90 (working copy)
***************
*** 0 ****
--- 1,37 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR92959, where compilation of ASSOCIATED segfaulted in 's1' and 's2'.
+ !
+ ! Contributed by Gerhard Steinmetz <[email protected]>
+ !
+ 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
