From 7067f8c814088c1d02e40adf79a80f5ec53dbdde Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 1 Mar 2020 16:04:38 +0000 Subject: [PATCH] Patch for PR92959 --- gcc/fortran/trans-intrinsic.c | 21 ++++++------ gcc/testsuite/gfortran.dg/associated_8.f90 | 37 ++++++++++++++++++++++ 2 files changed, 46 insertions(+), 12 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/associated_8.f90 diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 2567dc9c6a5..00bec1ec1df 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -8573,7 +8573,6 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) gfc_se arg2se; tree tmp2; tree tmp; - tree nonzero_charlen; tree nonzero_arraylen; gfc_ss *ss; bool scalar; @@ -8629,13 +8628,6 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) 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. */ @@ -8705,10 +8697,15 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) /* 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); + 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); diff --git a/gcc/testsuite/gfortran.dg/associated_8.f90 b/gcc/testsuite/gfortran.dg/associated_8.f90 new file mode 100644 index 00000000000..ca6e08e6464 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associated_8.f90 @@ -0,0 +1,37 @@ +! { dg-do run } +! +! Test the fix for PR92959, where compilation of ASSOCIATED segfaulted in 's1' and 's2'. +! +! Contributed by Gerhard Steinmetz +! +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 -- 2.30.2