Hi all,
The attached patch recovers most of the slowdown identified in the subject PR.
Test results from the original version of tonto SPEC benchmark are also
described in the PR126964 Comment #7:
"For the configuration in the initial report, I am getting roughly 2% slower
than the baseline before the blamed commit, meaning that most of the performance
has been recovered."
To develop this patch I used claude to analyze an archived open source copy of
tonto and generate an input "deck" to produce a local bench mark. This was
couple by multiple runs using callgrind to identify the "hot paths"
With the patch applied for a rank two dummy passed on from a loop calling it
120000 times, with a non-contiguous actual argument, the instructions executed
fall from 17151636793 to 11676814, against 10478570 before r17-3342.
As I stated above, this recovers most of the performance regression. It also has
peaked my curiosity so I plan some followup explorations.
Regression tested with full testsuite on x86_64.
OK for mainline?
Regards,
Jerry
---
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.
(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_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/gomp/target-span-1.f90: New test.
* gfortran.dg/c_loc_test_22.f90: Update for addressing by the
element length.
* gfortran.dg/class_to_type_9.f90: Likewise, and expect an
assumed shape dummy to take no copy of a strided actual argument.
commit 85c203ac84d38e1bd953c89e4d0aa92d93e4e9bb
Author: Jerry DeLisle <[email protected]>
Date: Mon Aug 24 08:48:16 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.
(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_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/gomp/target-span-1.f90: New test.
* gfortran.dg/c_loc_test_22.f90: Update for addressing by the
element length.
* 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 2f11b61a4b8..9f45fea07b1 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
@@ -7520,6 +7555,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));
+ }
+
gfc_trans_vla_type_sizes (sym, &init);
stmtInit = gfc_finish_block (&init);
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 1d85e5b94cd..236fad9f1e0 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1407,9 +1407,17 @@ 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. */
+ 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. */
if (gfc_is_span_addressed_dummy (sym) && packed == PACKED_NO)
- GFC_DECL_PTR_ARRAY_P (decl) = 1;
+ {
+ if (gfc_span_folds_into_stride (sym))
+ GFC_DECL_SPAN_NORMALIZED (decl) = 1;
+ else
+ GFC_DECL_PTR_ARRAY_P (decl) = 1;
+ }
if (sym->ns->proc_name->backend_decl == current_function_decl
|| sym->attr.contained)
@@ -1790,7 +1798,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 1c95f1ce2c4..3e31eadbc3a 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5558,7 +5558,8 @@ void
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)
+ gfc_symbol *sym, bool check_contiguous,
+ bool span_only)
{
gfc_se lse;
gfc_se rse;
@@ -5923,7 +5924,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);
@@ -6973,8 +6974,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
@@ -8034,13 +8063,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,
+ 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 06c96d5a0a9..647f5a498b2 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -2311,10 +2311,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;
@@ -2341,7 +2345,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;
@@ -2388,17 +2399,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 408acf081f1..7e7e7e2b5fb 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -564,9 +564,10 @@ void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent, bool,
const gfc_symbol *fsym = NULL,
const char *proc_name = NULL,
gfc_symbol *sym = NULL,
- bool check_contiguous = false);
+ bool check_contiguous = 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
@@ -1072,6 +1073,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;
};
@@ -1081,6 +1085,8 @@ struct GTY(()) lang_decl {
#define GFC_DECL_CAF_OFFSET(node) DECL_LANG_SPECIFIC(node)->caf_offset
#define GFC_DECL_SAVED_DESCRIPTOR(node) \
(DECL_LANG_SPECIFIC(node)->saved_descriptor)
+#define GFC_DECL_SPAN_NORMALIZED(node) \
+ (DECL_LANG_SPECIFIC(node)->span_normalized)
#define GFC_DECL_SCALAR_ALLOCATABLE(node) \
(DECL_LANG_SPECIFIC (node)->scalar_allocatable)
#define GFC_DECL_SCALAR_POINTER(node) \
diff --git a/gcc/testsuite/gfortran.dg/c_loc_test_22.f90 b/gcc/testsuite/gfortran.dg/c_loc_test_22.f90
index 91547e8e337..a4622b49c79 100644
--- a/gcc/testsuite/gfortran.dg/c_loc_test_22.f90
+++ b/gcc/testsuite/gfortran.dg/c_loc_test_22.f90
@@ -17,9 +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 descriptor's runtime
-! span, 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 "parm.\[0-9\]+.data = \\(void .\\) yyy.\[0-9\]+ \\+ \\(sizetype\\) \\(\\(yyy->span \\* D.\[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 "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
new file mode 100644
index 00000000000..0efd8ce709e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-span-1.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR 126964
+! PR 126950
+!
+! 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 read on entry and folded into the local strides, rather than the
+! target region dereferencing the descriptor.
+
+module m
+ use iso_c_binding
+contains
+ subroutine tgt (t)
+ real(c_double), target :: t(:)
+ !$omp target has_device_addr(t)
+ call inner (t(1))
+ !$omp end target
+ end subroutine tgt
+
+ subroutine inner (a)
+ real(c_double) :: a
+ end subroutine inner
+end module m
+
+! 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" } }
