Patch for PR92959

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 2567dc9c6a5f2e9028458981149f088aea25d932..00bec1ec1dfb97aa62f9458336279ff66133b8c6 100644 (file)
--- 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 (file)
index 0000000..ca6e08e
--- /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