1 files changed, 54 insertions, 7 deletions

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index b3f8871ff22..05134952db4 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -172,7 +172,7 @@ static tree
 gfc_get_cfi_dim_item (tree desc, tree idx, unsigned field_idx)
 {
   tree tmp = gfc_get_cfi_descriptor_field (desc, CFI_FIELD_DIM);
-  tmp = gfc_build_array_ref (tmp, idx, NULL);
+  tmp = gfc_build_array_ref (tmp, idx, NULL_TREE, true);
   tree field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), field_idx);
   gcc_assert (field != NULL_TREE);
   return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
@@ -424,7 +424,7 @@ gfc_conv_descriptor_dimension (tree desc, tree dim)
 
   tmp = gfc_get_descriptor_dimension (desc);
 
-  return gfc_build_array_ref (tmp, dim, NULL);
+  return gfc_build_array_ref (tmp, dim, NULL_TREE, true);
 }
 
 
@@ -3664,10 +3664,52 @@ build_class_array_ref (gfc_se *se, tree base, tree index)
 }
 
 
+/* Indicates that the tree EXPR is a reference to an array that can’t
+   have any negative stride.  */
+
+static bool
+non_negative_strides_array_p (tree expr)
+{
+  if (expr == NULL_TREE)
+    return false;
+
+  tree type = TREE_TYPE (expr);
+  if (POINTER_TYPE_P (type))
+    type = TREE_TYPE (type);
+
+  if (TYPE_LANG_SPECIFIC (type))
+    {
+      gfc_array_kind array_kind = GFC_TYPE_ARRAY_AKIND (type);
+
+      if (array_kind == GFC_ARRAY_ALLOCATABLE
+	  || array_kind == GFC_ARRAY_ASSUMED_SHAPE_CONT)
+	return true;
+    }
+
+  /* An array with descriptor can have negative strides.
+     We try to be conservative and return false by default here
+     if we don’t recognize a contiguous array instead of
+     returning false if we can identify a non-contiguous one.  */
+  if (!GFC_ARRAY_TYPE_P (type))
+    return false;
+
+  /* If the array was originally a dummy with a descriptor, strides can be
+     negative.  */
+  if (DECL_P (expr)
+      && DECL_LANG_SPECIFIC (expr)
+      && GFC_DECL_SAVED_DESCRIPTOR (expr)
+      && GFC_DECL_SAVED_DESCRIPTOR (expr) != expr)
+    return non_negative_strides_array_p (GFC_DECL_SAVED_DESCRIPTOR (expr));
+
+  return true;
+}
+
+
 /* Build a scalarized reference to an array.  */
 
 static void
-gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar)
+gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar,
+			       bool tmp_array = false)
 {
   gfc_array_info *info;
   tree decl = NULL_TREE;
@@ -3717,7 +3759,10 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar)
 	decl = info->descriptor;
     }
 
-  se->expr = gfc_build_array_ref (base, index, decl);
+  bool non_negative_stride = tmp_array
+			     || non_negative_strides_array_p (info->descriptor);
+  se->expr = gfc_build_array_ref (base, index, decl,
+				  non_negative_stride);
 }
 
 
@@ -3727,7 +3772,7 @@ void
 gfc_conv_tmp_array_ref (gfc_se * se)
 {
   se->string_length = se->ss->info->string_length;
-  gfc_conv_scalarized_array_ref (se, NULL);
+  gfc_conv_scalarized_array_ref (se, NULL, true);
   gfc_advance_se_ss_chain (se);
 }
 
@@ -3779,7 +3824,9 @@ build_array_ref (tree desc, tree offset, tree decl, tree vptr)
 
   tmp = gfc_conv_array_data (desc);
   tmp = build_fold_indirect_ref_loc (input_location, tmp);
-  tmp = gfc_build_array_ref (tmp, offset, decl, vptr);
+  tmp = gfc_build_array_ref (tmp, offset, decl,
+			     non_negative_strides_array_p (desc),
+			     vptr);
   return tmp;
 }
 
@@ -7723,7 +7770,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
       lse.ss = loop.temp_ss;
       rse.ss = ss;
 
-      gfc_conv_scalarized_array_ref (&lse, NULL);
+      gfc_conv_tmp_array_ref (&lse);
       if (expr->ts.type == BT_CHARACTER)
 	{
 	  gfc_conv_expr (&rse, expr);