[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