[PATCH] [17 Regression] 4-5% slowdown of tonto of Zen{2, 3, 4, 5} since r17-3342-gf3943597388db4

commit 63cf8a75f02df990e2fb7422ba8b2fe72a826fab
Author: Jerry DeLisle <[email protected]>
Date:   Fri Aug 21 16:17:14 2026 -0700

    fortran: [PR126964] Reduce the cost of a span addressed dummy
    
    Assisted-by: Claude Opus 5
    
    r17-3342 made a TARGET assumed shape or assumed rank dummy be addressed
    through the span of its descriptor, so that a pointer to it stays valid
    when its elements are subobjects of larger ones.  That costs in two ways,
    and SPEC 465.tonto pays both.
    
    First, is_subref_array became true for such a dummy, so passing one on to
    another procedure takes the copy-in/copy-out path, with the copy made
    conditional on the actual argument being contiguous.  That is more than
    the receiving dummy needs: a dummy that has a descriptor of its own
    addresses its elements by the strides held in it, so it accepts an actual
    argument of any stride; the one thing it cannot do is address elements
    that are subobjects of larger ones, which is what a span differing from
    the element length means.  Narrow the condition to the span alone when the
    dummy has a descriptor and is not CONTIGUOUS.  A dummy that needs the
    argument packed still gets the full test.
    
    Second, addressing every element as offset * span leaves the step of a
    data reference symbolic, so loop versioning cannot prove that the accesses
    stay aligned and the loop is never vectorized.  Fold the spacing into the
    strides and the offset on entry instead, so that the elements are
    addressed by the constant element length as usual.  The element length
    divides the spacing whenever the element size equals the element
    alignment, which covers integer, real and logical elements of an assumed
    shape dummy; elsewhere the span is still used to address them.
    
            PR fortran/126964
    
    gcc/fortran/ChangeLog:
    
            * trans.h (struct lang_decl): Add span_normalized.
            (GFC_DECL_SPAN_NORMALIZED): New macro.
            (gfc_conv_subref_array_arg): Add span_only argument.
            (gfc_conv_is_contiguous_expr): Likewise.
            * trans-array.h (gfc_span_folds_into_stride): New prototype.
            * trans-array.cc (gfc_span_folds_into_stride): New function.
            (gfc_trans_dummy_array_bias): Fold the element spacing of a span
            normalized dummy into its strides and its offset on entry.
            * trans-decl.cc (gfc_build_dummy_array_decl): Mark such a dummy
            span normalized rather than giving it a span variable.
            (gfc_get_symbol_decl): Do not set GFC_DECL_PTR_ARRAY_P for it.
            * trans-intrinsic.cc (gfc_conv_is_contiguous_expr): Take span_only
            and, with it, test that the span of the descriptor is the element
            length without testing the strides.
            * trans-expr.cc (is_whole_span_addressed_dummy): New function.
            (dummy_accepts_strided_arg): New function.
            (gfc_conv_subref_array_arg): Take span_only and pass it on.
            (gfc_conv_procedure_call): Ask for the span test when a span
            addressed dummy is passed on to a dummy that has a descriptor.
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/target_dummy_repack_1.f90: New test.
            * gfortran.dg/target_dummy_span_1.f90: New test.
            * gfortran.dg/c_loc_test_22.f90: Update for addressing by the
            element length.
            * gfortran.dg/gomp/target-span-1.f90: Likewise.
            * gfortran.dg/class_to_type_9.f90: Likewise, and expect an
            assumed shape dummy to take no copy of a strided actual argument.

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index b07339b87cb..4666517a5fd 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -514,6 +514,41 @@ span_addressed_array (tree expr)
 }
 
 
+/* An actual argument whose elements are subobjects can be described to a
+   span addressed dummy by the strides of its descriptor instead of by its
+   span, provided the element length divides the spacing.  That holds when
+   the element size equals the element alignment: the type of the object the
+   elements are part of is then at least as aligned, so its size, and hence
+   the spacing, is a multiple of the element length.  Folding the spacing
+   into the strides lets the elements be addressed by a constant element
+   length, which keeps the address evolutions analyzable.  */
+
+bool
+gfc_span_folds_into_stride (gfc_symbol *sym)
+{
+  if (!gfc_is_span_addressed_dummy (sym))
+    return false;
+
+  /* A character element length is not necessarily constant and a complex or
+     derived type can be larger than its alignment.  */
+  if (sym->ts.type != BT_INTEGER
+      && sym->ts.type != BT_REAL
+      && sym->ts.type != BT_LOGICAL)
+    return false;
+
+  /* An assumed rank dummy has no strides to fold the spacing into.  */
+  if (!sym->as || sym->as->type != AS_ASSUMED_SHAPE || sym->as->rank < 1)
+    return false;
+
+  tree etype = gfc_typenode_for_spec (&sym->ts);
+  tree size = etype ? TYPE_SIZE_UNIT (etype) : NULL_TREE;
+
+  return (size
+	  && tree_fits_uhwi_p (size)
+	  && tree_to_uhwi (size) == TYPE_ALIGN_UNIT (etype));
+}
+
+
 /* If the symbol or expression reference a CFI descriptor, return the
    pointer to the converted gfc descriptor. If an array reference is
    present as the last argument, check that it is the one applied to
@@ -7539,6 +7574,45 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
   if (VAR_P (GFC_TYPE_ARRAY_OFFSET (type)))
     gfc_add_modify (&init, GFC_TYPE_ARRAY_OFFSET (type), offset);
 
+  /* Fold the element spacing of the actual argument into the strides and the
+     offset, so that the elements are addressed by the constant element length
+     rather than by a span loaded from the descriptor.  The unit case is kept
+     as a separate arm of the conditional rather than folded into the
+     multiplication, so that the strides remain recognizable as being one for
+     a contiguous innermost dimension.  */
+  if (DECL_LANG_SPECIFIC (tmpdesc) && GFC_DECL_SPAN_NORMALIZED (tmpdesc))
+    {
+      tree element = fold_convert (gfc_array_index_type,
+				   TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+      tree span = gfc_evaluate_now (gfc_conv_descriptor_span_get (dumdesc),
+				    &init);
+      tree unit = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
+				   span, element);
+      tree factor = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+				     gfc_array_index_type, span, element);
+      factor = gfc_evaluate_now (factor, &init);
+
+      auto scale = [&] (tree var)
+	{
+	  tree scaled = fold_build2_loc (input_location, MULT_EXPR,
+					 gfc_array_index_type, var, factor);
+	  scaled = fold_build3_loc (input_location, COND_EXPR,
+				    gfc_array_index_type, unit, var, scaled);
+	  gfc_add_modify (&init, var, scaled);
+	};
+
+      for (n = 0; n < as->rank; n++)
+	{
+	  /* A span addressed dummy is never repacked, so every stride is a
+	     variable loaded from the descriptor.  */
+	  gcc_assert (VAR_P (GFC_TYPE_ARRAY_STRIDE (type, n)));
+	  scale (GFC_TYPE_ARRAY_STRIDE (type, n));
+	}
+
+      if (VAR_P (GFC_TYPE_ARRAY_OFFSET (type)))
+	scale (GFC_TYPE_ARRAY_OFFSET (type));
+    }
+
   /* Load the span once here, like the bounds above, so that element
      addressing does not reload it from the descriptor.  The descriptor
      itself is not available in an outlined region, such as an OpenMP
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index c0afccb28e2..b98444b2ca5 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -148,6 +148,9 @@ void gfc_conv_tmp_array_ref (gfc_se * se);
 void gfc_get_dataptr_offset (stmtblock_t*, tree, tree, tree, bool, gfc_expr*);
 /* Obtain the span of an array.  */
 tree gfc_get_array_span (tree, gfc_expr *);
+/* Whether the element spacing of a span addressed dummy can be folded into
+   the strides of its descriptor.  */
+bool gfc_span_folds_into_stride (gfc_symbol *);
 /* Evaluate an array expression.  */
 void gfc_conv_expr_descriptor (gfc_se *, gfc_expr *);
 /* Convert an array for passing as an actual function parameter.  */
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 9181add87dd..6e8bdc28582 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1407,13 +1407,21 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
   GFC_DECL_SAVED_DESCRIPTOR (decl) = dummy;
 
   /* The elements of the actual argument can be spaced by more than the
-     element size, so the span of the descriptor is used to address them.
-     Create the variable that holds it here, since the body is translated
-     before gfc_trans_dummy_array_bias loads it from the descriptor.  */
+     element size.  Where the element length divides that spacing, it is
+     folded into the strides on entry and the elements are addressed by the
+     element length as usual.  Otherwise the span of the descriptor is used
+     to address them; create the variable that holds it here, since the body
+     is translated before gfc_trans_dummy_array_bias loads it from the
+     descriptor.  */
   if (gfc_is_span_addressed_dummy (sym) && packed == PACKED_NO)
     {
-      GFC_DECL_PTR_ARRAY_P (decl) = 1;
-      GFC_DECL_SPAN (decl) = gfc_create_var (gfc_array_index_type, "span");
+      if (gfc_span_folds_into_stride (sym))
+	GFC_DECL_SPAN_NORMALIZED (decl) = 1;
+      else
+	{
+	  GFC_DECL_PTR_ARRAY_P (decl) = 1;
+	  GFC_DECL_SPAN (decl) = gfc_create_var (gfc_array_index_type, "span");
+	}
     }
 
   if (sym->ns->proc_name->backend_decl == current_function_decl
@@ -1795,7 +1803,8 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	gfc_defer_symbol_init (sym);
 
       if ((sym->attr.pointer && sym->attr.dimension && sym->ts.type != BT_CLASS)
-	  || gfc_is_span_addressed_dummy (sym))
+	  || (gfc_is_span_addressed_dummy (sym)
+	      && !gfc_span_folds_into_stride (sym)))
 	GFC_DECL_PTR_ARRAY_P (sym->backend_decl) = 1;
 
       /* Create a character length variable.  */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 51b618e5083..0eb470d9cb0 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5559,7 +5559,7 @@ gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr, int g77,
 			   sym_intent intent, bool formal_ptr,
 			   const gfc_symbol *fsym, const char *proc_name,
 			   gfc_symbol *sym, bool check_contiguous,
-			   bool deep_copy)
+			   bool deep_copy, bool span_only)
 {
   gfc_se lse;
   gfc_se rse;
@@ -5937,7 +5937,7 @@ class_array_fcn:
 	    {
 	      /* cont_var = is_contiguous (expr); .  */
 	      gfc_init_se (&cont_se, parmse);
-	      gfc_conv_is_contiguous_expr (&cont_se, expr);
+	      gfc_conv_is_contiguous_expr (&cont_se, expr, span_only);
 	      gfc_add_block_to_block (&se->pre, &(&cont_se)->pre);
 	      gfc_add_modify (&se->pre, cont_var, cont_se.expr);
 	      gfc_add_block_to_block (&se->pre, &(&cont_se)->post);
@@ -7592,8 +7592,36 @@ is_subobject_ref (gfc_expr *e)
 }
 
 
-/* Return true if the actual argument E for the dummy FSYM may be passed as a
-   copy-in/copy-out temporary.  A pointer associated with a TARGET or POINTER
+/* Return true if expr is a span addressed dummy that is passed on as a whole,
+   rather than a reference to a subobject of the elements of an array.  */
+
+static bool
+is_whole_span_addressed_dummy (gfc_expr *e)
+{
+  return e->expr_type == EXPR_VARIABLE
+	 && e->symtree && e->symtree->n.sym
+	 && gfc_is_span_addressed_dummy (e->symtree->n.sym)
+	 && !is_subobject_ref (e);
+}
+
+
+/* Return true if the dummy fsym has an array descriptor and so addresses its
+   elements by the strides held in it.  Such a dummy accepts an actual
+   argument of any stride; only a dummy without a descriptor, or one declared
+   CONTIGUOUS, needs it packed into contiguous storage.  */
+
+static bool
+dummy_accepts_strided_arg (gfc_symbol *fsym, bool nodesc_arg)
+{
+  return fsym && !nodesc_arg && !fsym->attr.contiguous && fsym->as
+	 && (fsym->as->type == AS_ASSUMED_SHAPE
+	     || fsym->as->type == AS_ASSUMED_RANK
+	     || fsym->as->type == AS_DEFERRED);
+}
+
+
+/* Return true if the actual argument expr for the dummy fsym may be passed as
+   a copy-in/copy-out temporary.  A pointer associated with a TARGET or POINTER
    dummy must remain valid after the call, so the actual argument is passed
    directly, with a descriptor whose span provides the element spacing.  An
    actual argument with a vector subscript is not definable and its pointer
@@ -8709,13 +8737,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		   is converted to a temporary, which is passed and then
 		   written back after the procedure call.  The elements of
 		   a span addressed dummy passed on as a whole are usually
-		   contiguous, so the copy is made conditional.  */
-		gfc_conv_subref_array_arg (&parmse, e, nodesc_arg,
+		   contiguous, so the copy is made conditional.  A dummy that
+		   has a descriptor takes any stride, so for it the condition
+		   is only that the span be the element length.  */
+		{
+		  bool whole_span = is_whole_span_addressed_dummy (e);
+		  gfc_conv_subref_array_arg (&parmse, e, nodesc_arg,
 				fsym ? fsym->attr.intent : INTENT_INOUT,
 				fsym && fsym->attr.pointer, fsym, sym->name,
-				NULL,
-				gfc_is_span_addressed_dummy (e->symtree->n.sym)
-				&& !is_subobject_ref (e));
+				NULL, whole_span, false,
+				whole_span
+				&& dummy_accepts_strided_arg (fsym,
+							      nodesc_arg));
+		}
 
 	      else if (e->ts.type == BT_CLASS && CLASS_DATA (e)->as
 		       && CLASS_DATA (e)->as->type == AS_ASSUMED_SIZE
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 62aba7af435..257d5df20ab 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -2359,10 +2359,14 @@ gfc_conv_intrinsic_is_contiguous (gfc_se * se, gfc_expr * expr)
 }
 
 /* This function does the work for gfc_conv_intrinsic_is_contiguous,
-   plus it can be called directly.  */
+   plus it can be called directly.  With SPAN_ONLY, the strides are not
+   tested and the result is just that the span of the descriptor is the
+   element length, ie. that the elements are not subobjects of larger ones.
+   That is all that has to hold for a dummy that has a descriptor of its own,
+   since it addresses its elements by the strides held in it.  */
 
 void
-gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg)
+gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg, bool span_only)
 {
   gfc_ss *ss;
   gfc_se argse;
@@ -2389,7 +2393,14 @@ gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg)
   /* Create:  stride[0] == 1 && stride[1] == extend[0]*stride[0] && ...
      Note in addition that zero-sized arrays don't count as contiguous.  */
 
-  if (as && as->type == AS_ASSUMED_RANK)
+  if (span_only)
+    {
+      gfc_add_block_to_block (&se->pre, &argse.pre);
+      gfc_add_block_to_block (&se->post, &argse.post);
+      desc = gfc_evaluate_now (argse.expr, &se->pre);
+      se->expr = NULL_TREE;
+    }
+  else if (as && as->type == AS_ASSUMED_RANK)
     {
       /* Build the call to is_contiguous0.  */
       argse.want_pointer = 1;
@@ -2436,17 +2447,20 @@ gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg)
 
   /* An array that is addressed by the span of its descriptor needs to be
      checked if that span differs from the element size.  */
-  if (as && sym && !sym->attr.contiguous
-      && (IS_POINTER (sym) || gfc_is_span_addressed_dummy (sym)))
+  if (span_only
+      || (as && sym && !sym->attr.contiguous
+	  && (IS_POINTER (sym) || gfc_is_span_addressed_dummy (sym))))
     {
       tree span = gfc_conv_descriptor_span_get (desc);
       tmp = fold_convert (TREE_TYPE (span),
 			  gfc_conv_descriptor_elem_len_get (desc));
       cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
 			      span, tmp);
-      se->expr = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
-				  boolean_type_node, cond,
-				  convert (boolean_type_node, se->expr));
+      se->expr = se->expr == NULL_TREE
+		 ? cond
+		 : fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
+				    boolean_type_node, cond,
+				    convert (boolean_type_node, se->expr));
     }
 
   if (as && as->type == AS_ASSUMED_RANK)
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 016d3971a35..991f94ed7ca 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -565,9 +565,10 @@ void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent, bool,
 				const char *proc_name = NULL,
 				gfc_symbol *sym = NULL,
 				bool check_contiguous = false,
-				bool deep_copy = false);
+				bool deep_copy = false,
+				bool span_only = false);
 
-void gfc_conv_is_contiguous_expr (gfc_se *, gfc_expr *);
+void gfc_conv_is_contiguous_expr (gfc_se *, gfc_expr *, bool span_only = false);
 
 /* Generate code for a scalar assignment.  */
 tree
@@ -1075,6 +1076,9 @@ struct GTY(()) lang_decl {
   unsigned int scalar_pointer : 1;
   unsigned int scalar_target : 1;
   unsigned int optional_arg : 1;
+  /* The element spacing of this dummy is held by the strides of its
+     descriptor rather than by its span.  */
+  unsigned int span_normalized : 1;
 };
 
 
@@ -1085,6 +1089,8 @@ struct GTY(()) lang_decl {
 #define GFC_DECL_SAVED_DESCRIPTOR(node) \
   (DECL_LANG_SPECIFIC(node)->saved_descriptor)
 #define GFC_DECL_SPAN(node) (DECL_LANG_SPECIFIC(node)->span)
+#define GFC_DECL_SPAN_NORMALIZED(node) \
+  (DECL_LANG_SPECIFIC(node)->span_normalized)
 /* Return the cached span of a span addressed dummy, or NULL_TREE.  */
 #define GFC_DECL_GET_SPAN(node) \
   (DECL_P (node) && DECL_LANG_SPECIFIC (node) \
diff --git a/gcc/testsuite/gfortran.dg/c_loc_test_22.f90 b/gcc/testsuite/gfortran.dg/c_loc_test_22.f90
index 2360c33913b..fa5b06a588d 100644
--- a/gcc/testsuite/gfortran.dg/c_loc_test_22.f90
+++ b/gcc/testsuite/gfortran.dg/c_loc_test_22.f90
@@ -17,11 +17,12 @@ end
 ! { dg-final { scan-tree-dump-not " _gfortran_internal_pack" "original" } }
 ! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) &\\(.xxx.\[0-9\]+\\)\\\[0\\\];" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) &\\(.xxx.\[0-9\]+\\)\\\[D.\[0-9\]+ \\* 4\\\];" 1 "original" } }
-! A TARGET assumed-shape dummy is addressed with the runtime span that is
-! loaded from the descriptor on entry, so the element offset is span-scaled
-! instead of a constant 16.
-! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) &\\(.yyy.\[0-9\]+\\)\\\[0\\\];" 1 "original" } }
-! { dg-final { scan-tree-dump-times "span.\[0-9\]+ = yyy->span;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) yyy.\[0-9\]+ \\+ \\(sizetype\\) \\(\\(D.\[0-9\]+ \\* span.\[0-9\]+\\) \\* 4\\);" 1 "original" } }
+! The elements of a TARGET assumed-shape dummy can be spaced by more than the
+! element length.  For an element length that divides the spacing, the spacing
+! is folded into the strides on entry, so the elements are addressed by the
+! constant element length rather than by a span loaded from the descriptor.
+! { dg-final { scan-tree-dump-not "span.\[0-9\]+ = yyy->span;" "original" } }
+! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) yyy.\[0-9\]+;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) yyy.\[0-9\]+ \\+ \\(sizetype\\) \\(D.\[0-9\]+ \\* 16\\);" 1 "original" } }
 
 ! { dg-final { scan-tree-dump-times "D.\[0-9\]+ = parm.\[0-9\]+.data;\[^;]+ptr\[1-4\] = D.\[0-9\]+;" 4 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/class_to_type_9.f90 b/gcc/testsuite/gfortran.dg/class_to_type_9.f90
index 40f4e6a53de..47d90c5080e 100644
--- a/gcc/testsuite/gfortran.dg/class_to_type_9.f90
+++ b/gcc/testsuite/gfortran.dg/class_to_type_9.f90
@@ -1,10 +1,11 @@
 ! { dg-do run }
 ! PR fortran/53800
+! PR126964
 
 ! A TARGET dummy associated with elements that are spaced by more than the
 ! element size: pointers to it stay valid after the call, it is written
-! through, it is not contiguous, it is copied when passed on to a dummy
-! without the TARGET attribute and it is transferred element by element.
+! through, it is not contiguous, it is passed on to an assumed-shape dummy
+! by its strides and copied for a dummy that has no descriptor.
 
 module m
   implicit none
@@ -22,15 +23,15 @@ contains
     write (line, '(4I3)') a
     if (line(1:12) /= '  1  4  9 16') stop 3
     if (sum(a) /= 30) stop 4
-    call packed(a)
+    call assumed_shape(a)
     call assumed_size(a)
     saved => a
     a(2) = -a(2)
   end subroutine
-  subroutine packed(b)         ! copy-in/copy-out
+  subroutine assumed_shape(b)  ! strides passed on, no copy
     integer :: b(:)
     if (any(b /= [1, 4, 9, 16])) stop 5
-    if (.not. is_contiguous(b)) stop 6
+    if (is_contiguous(b)) stop 6
   end subroutine
   subroutine assumed_size(c)   ! no descriptor
     integer :: c(*)
diff --git a/gcc/testsuite/gfortran.dg/gomp/target-span-1.f90 b/gcc/testsuite/gfortran.dg/gomp/target-span-1.f90
index 30ba7e1862e..e391d1bbc02 100644
--- a/gcc/testsuite/gfortran.dg/gomp/target-span-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/target-span-1.f90
@@ -2,11 +2,12 @@
 ! { dg-additional-options "-fdump-tree-original" }
 !
 ! PR fortran/126950
+! PR126964
 !
 ! A TARGET assumed-shape dummy is addressed through the span of its
 ! descriptor.  The descriptor is not mapped to the device, so the span has
-! to be loaded into a local variable on entry and that variable used inside
-! the target region, rather than the region dereferencing the descriptor.
+! to be read on entry and folded into the local strides, rather than the
+! target region dereferencing the descriptor.
 
 module m
   use iso_c_binding
@@ -23,8 +24,9 @@ contains
   end subroutine inner
 end module m
 
-! The span is loaded from the descriptor once, on entry.
-! { dg-final { scan-tree-dump-times "span\.\[0-9\]+ = t->span;" 1 "original" } }
-! The element reference uses that variable, not the descriptor.
-! { dg-final { scan-tree-dump "t\.\[0-9\]+ \\+ \\(sizetype\\) \\(\\(offset\.\[0-9\]+ \\+ \[^)\]*stride\.\[0-9\]+\[^)\]*\\) \\* span\.\[0-9\]+\\)" "original" } }
+! The span is read from the descriptor once, on entry, and scales the strides.
+! { dg-final { scan-tree-dump-times "= t->span;" 1 "original" } }
+! { dg-final { scan-tree-dump "stride\.\[0-9\]+ = \[^;\]* != 8 \\? stride\.\[0-9\]+ \\* \[^;\]* : stride\.\[0-9\]+;" "original" } }
+! The element reference uses the local strides and the element length.
+! { dg-final { scan-tree-dump "t\.\[0-9\]+ \\+ \\(sizetype\\) \\(\\(offset\.\[0-9\]+ \\+ \[^)\]*stride\.\[0-9\]+\[^)\]*\\) \\* 8\\)" "original" } }
 ! { dg-final { scan-tree-dump-not "\\* t->span" "original" } }
diff --git a/gcc/testsuite/gfortran.dg/target_dummy_repack_1.f90 b/gcc/testsuite/gfortran.dg/target_dummy_repack_1.f90
new file mode 100644
index 00000000000..d2379488ce9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/target_dummy_repack_1.f90
@@ -0,0 +1,77 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+! PR126964
+! A TARGET assumed-shape dummy is addressed through the span of its
+! descriptor.  When it is passed on to a dummy that has a descriptor of its
+! own, that dummy addresses the elements by the strides it holds, so the only
+! condition for passing it directly is that the span be the element length.
+! Testing full contiguity instead made a non-contiguous actual argument be
+! copied on every call.
+!
+module m
+  implicit none
+contains
+
+  ! Assumed shape, no TARGET: takes any stride, needs no repacking.
+  real function elem (a, i, j) result (s)
+    real, intent(in) :: a(:,:)
+    integer, intent(in) :: i, j
+    s = a(i,j)
+  end function
+
+  real function sum_target (self) result (s)
+    real, target, intent(in) :: self(:,:)
+    integer :: i, j
+    s = 0.0
+    do j = 1, size (self,2)
+       do i = 1, size (self,1)
+          s = s + elem (self, i, j)
+       end do
+    end do
+  end function
+
+  real function sum_plain (self) result (s)
+    real, intent(in) :: self(:,:)
+    integer :: i, j
+    s = 0.0
+    do j = 1, size (self,2)
+       do i = 1, size (self,1)
+          s = s + elem (self, i, j)
+       end do
+    end do
+  end function
+
+end module
+
+program p
+  use m
+  implicit none
+  integer, parameter :: n = 6
+  real, allocatable, target :: a(:,:)
+  real :: expect
+  integer :: i, j
+
+  allocate (a(2*n,n))
+  do j = 1, n
+     do i = 1, 2*n
+        a(i,j) = real (i + 100*j)
+     end do
+  end do
+
+  ! Contiguous actual argument.
+  expect = sum_plain (a)
+  if (abs (sum_target (a) - expect) > 1.0e-4) stop 1
+
+  ! Non-contiguous actual argument: every other row.
+  expect = sum_plain (a(1:2*n:2,:))
+  if (abs (sum_target (a(1:2*n:2,:)) - expect) > 1.0e-4) stop 2
+
+  ! A section of the second dimension too.
+  expect = sum_plain (a(1:2*n:2,2:n:2))
+  if (abs (sum_target (a(1:2*n:2,2:n:2)) - expect) > 1.0e-4) stop 3
+
+end program
+
+! The condition for passing the dummy on must be the span alone; testing the
+! strides as well would repack a non-contiguous actual argument needlessly.
+! { dg-final { scan-tree-dump "contiguous\\.\[0-9\]+ = \[^;\]*span == \[^;&\]*elem_len;" "original" } }
diff --git a/gcc/testsuite/gfortran.dg/target_dummy_span_1.f90 b/gcc/testsuite/gfortran.dg/target_dummy_span_1.f90
new file mode 100644
index 00000000000..43870a2be78
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/target_dummy_span_1.f90
@@ -0,0 +1,62 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR126964
+!
+! The elements of a TARGET assumed-shape dummy can be spaced by more than
+! the element length.  Where the element length divides the spacing, the
+! spacing is folded into the strides on entry, so that the elements are
+! addressed by the constant element length rather than by a span loaded
+! from the descriptor.  Addressing by a runtime span leaves the data
+! reference step symbolic, which stops the loops from being vectorized.
+
+module m
+  implicit none
+  type :: t
+    real(8) :: a, b
+  end type
+  real(8), pointer :: saved(:,:) => null()
+contains
+  subroutine axpy (self, n)
+    real(8), dimension(:,:), target :: self
+    integer, intent(in) :: n
+    integer :: k
+    do k = 1, n - 1
+      self(:,n) = self(:,n) + self(:,k)
+    end do
+    saved => self
+  end subroutine
+end module
+
+program p
+  use m
+  implicit none
+  type(t), target :: x(4,3)
+  integer :: i, j
+  x%a = -1.0_8
+  x%b = reshape ([(real (i, 8), i = 1, 12)], [4, 3])
+
+  call axpy (x%b, 3)
+
+  do j = 1, 2
+    do i = 1, 4
+      if (x(i,j)%b /= real (i + 4*(j-1), 8)) stop 1
+    end do
+  end do
+  if (any (x(:,3)%b /= [15.0_8, 18.0_8, 21.0_8, 24.0_8])) stop 2
+  if (any (x%a /= -1.0_8)) stop 3
+
+  saved = 0.0_8
+  if (any (x%b /= 0.0_8)) stop 4
+  if (any (x%a /= -1.0_8)) stop 5
+end program
+
+! The spacing is read from the descriptor once, on entry, and scales both
+! strides and the offset.
+! { dg-final { scan-tree-dump-times "= self->span;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\\? stride\.\[0-9\]+ \\* \[^;\]+ : stride\.\[0-9\]+;" 2 "original" } }
+! { dg-final { scan-tree-dump-times "\\? offset\.\[0-9\]+ \\* \[^;\]+ : offset\.\[0-9\]+;" 1 "original" } }
+! No span variable is created and the elements are addressed by the element
+! length.
+! { dg-final { scan-tree-dump-not "span\.\[0-9\]+" "original" } }
+! { dg-final { scan-tree-dump-not "\\* self->span" "original" } }