[gcc(refs/vendors/ibm/heads/perf)] Patch for PR92959
Jiu Fu Guo
guojiufu@gcc.gnu.org
Thu Mar 19 06:00:52 GMT 2020
https://gcc.gnu.org/g:7067f8c814088c1d02e40adf79a80f5ec53dbdde
commit 7067f8c814088c1d02e40adf79a80f5ec53dbdde
Author: Paul Thomas <pault@pc30.home>
Date: Sun Mar 1 16:04:38 2020 +0000
Patch for PR92959
Diff:
---
gcc/fortran/trans-intrinsic.c | 21 ++++++++---------
gcc/testsuite/gfortran.dg/associated_8.f90 | 37 ++++++++++++++++++++++++++++++
2 files changed, 46 insertions(+), 12 deletions(-)
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 <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
More information about the Gcc-cvs
mailing list