Re: [PATCH] fortran: [PR53800] Wrong copy-in/out with array actual to, TARGET dummy

From f47f69ef29a10a4b0218c504ffef1bc375037323 Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Mon, 10 Aug 2026 09:37:01 -0700
Subject: [PATCH] fortran: [PR53800] Wrong copy-in/out with array actual to
 TARGET dummy

An actual argument whose elements are spaced by more than the element
size - a CLASS array, or a component of a derived-type array - was
copied in and out when passed to a TARGET or POINTER dummy, so pointers
associated with the dummy went stale on return.

Such an actual argument is now passed with a descriptor of its own,
whose element type is that of the subobject and whose span is the
element size of the array, as is already done for a pointer assignment
to a subobject of an array.  The dummy addresses its elements through
that span.  Passing it on to a dummy that requires contiguous storage
copies it, but only if it turns out not to be contiguous.

	PR fortran/53800

gcc/fortran/ChangeLog:

	* gfortran.h (gfc_is_span_addressed_dummy): New prototype.
	* symbol.cc (gfc_is_span_addressed_dummy): New function.
	* expr.cc (is_subref_array): Return true for a span addressed dummy.
	* trans.h (gfc_get_span_descriptor): New prototype.
	* trans.cc (gfc_get_span_descriptor): New function returning the
	descriptor that carries a pointer array decl's span.
	(get_array_span): Use it, including for character types.
	* trans-array.cc (is_pointer_array): Note in the comment that the
	tree must be a descriptor.
	(span_addressed_array): New function returning the decl that
	provides the span of an array.
	(gfc_get_array_span): Use it.
	(gfc_conv_scalarized_array_ref, gfc_conv_array_ref): Likewise, so
	that a descriptorless dummy is addressed by its span.
	(gfc_get_dataptr_offset): Likewise and dereference a spanned
	character element.
	(gfc_conv_expr_descriptor): Describe a subobject of the array
	elements by a new descriptor when no temporary is made.
	* trans-decl.cc (gfc_build_dummy_array_decl): Use
	gfc_is_span_addressed_dummy to mark the dummy as a pointer array.
	(gfc_get_symbol_decl): Likewise.
	* trans-expr.cc (is_subobject_ref): New function.
	(copy_in_out_allowed): Take the actual argument.  Use
	gfc_is_span_addressed_dummy and keep the copy for an actual
	argument with a vector subscript.
	(gfc_conv_gfc_desc_to_cfi_desc): Remove the now duplicate offsetting
	of the data pointer for a subobject reference.
	(gfc_class_array_data_assign): Also copy the span field.
	(gfc_conv_procedure_call): Use copy_in_out_allowed to skip
	copy-in/copy-out for a class array reference, a class array function
	result and a subref array.  Pass a spanned descriptor instead and
	make the copy of a span addressed dummy conditional on it not being
	contiguous.
	* trans-intrinsic.cc (gfc_conv_is_contiguous_expr): Check the span
	of a span addressed dummy against the element length.

gcc/testsuite/ChangeLog:

	* gfortran.dg/c_loc_test_22.f90: Update dump patterns for span
	addressing.
	* gfortran.dg/class_to_type_5.f90: New test.
	* gfortran.dg/class_to_type_6.f90: New test.
	* gfortran.dg/class_to_type_7.f90: New test.
	* gfortran.dg/class_to_type_8.f90: New test.
	* gfortran.dg/class_to_type_9.f90: New test.

libgomp/ChangeLog:

	* testsuite/libgomp.oacc-fortran/host_data-5.F90: Update the
	privatization notes for the packing of a TARGET dummy.
---
 gcc/fortran/expr.cc                           |   3 +-
 gcc/fortran/gfortran.h                        |   1 +
 gcc/fortran/symbol.cc                         |  24 +++
 gcc/fortran/trans-array.cc                    |  69 +++++---
 gcc/fortran/trans-decl.cc                     |  22 ++-
 gcc/fortran/trans-expr.cc                     |  92 ++++++++---
 gcc/fortran/trans-intrinsic.cc                |   7 +-
 gcc/fortran/trans.cc                          |  31 +++-
 gcc/fortran/trans.h                           |   3 +
 gcc/testsuite/gfortran.dg/c_loc_test_22.f90   |   6 +-
 gcc/testsuite/gfortran.dg/class_to_type_5.f90 |  35 ++++
 gcc/testsuite/gfortran.dg/class_to_type_6.f90 |  93 +++++++++++
 gcc/testsuite/gfortran.dg/class_to_type_7.f90 | 151 ++++++++++++++++++
 gcc/testsuite/gfortran.dg/class_to_type_8.f90 |  47 ++++++
 gcc/testsuite/gfortran.dg/class_to_type_9.f90 |  67 ++++++++
 .../libgomp.oacc-fortran/host_data-5.F90      |  15 +-
 16 files changed, 612 insertions(+), 54 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/class_to_type_5.f90
 create mode 100644 gcc/testsuite/gfortran.dg/class_to_type_6.f90
 create mode 100644 gcc/testsuite/gfortran.dg/class_to_type_7.f90
 create mode 100644 gcc/testsuite/gfortran.dg/class_to_type_8.f90
 create mode 100644 gcc/testsuite/gfortran.dg/class_to_type_9.f90

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 20eddbefd57..52945a1db13 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -1222,7 +1222,8 @@ is_subref_array (gfc_expr * e)
 
   sym = e->symtree->n.sym;
 
-  if (sym->attr.subref_array_pointer)
+  if (sym->attr.subref_array_pointer
+      || gfc_is_span_addressed_dummy (sym))
     return true;
 
   seen_array = false;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 5bd8dd50c1c..2a1f1608fba 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3971,6 +3971,7 @@ bool gfc_check_symbol_typed (gfc_symbol*, gfc_namespace*, bool, locus);
 gfc_namespace* gfc_find_proc_namespace (gfc_namespace*);
 
 bool gfc_is_associate_pointer (gfc_symbol*);
+bool gfc_is_span_addressed_dummy (gfc_symbol *);
 gfc_symbol * gfc_find_dt_in_generic (gfc_symbol *);
 gfc_formal_arglist *gfc_sym_get_dummy_args (gfc_symbol *);
 
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 36e1262fff5..dde3e92a33d 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -5702,6 +5702,30 @@ gfc_is_associate_pointer (gfc_symbol* sym)
 }
 
 
+/* Check if a dummy argument must be addressed using the span of its
+   descriptor.  The actual argument of an assumed shape or assumed rank
+   TARGET dummy is never copied, so its elements can be spaced by more
+   than the element size.  CLASS and assumed type entities already carry
+   their element size and are excluded.  */
+
+bool
+gfc_is_span_addressed_dummy (gfc_symbol *sym)
+{
+  return sym->attr.dummy
+	 && sym->attr.target
+	 && sym->attr.dimension
+	 && !sym->attr.value
+	 && !sym->attr.contiguous
+	 && !sym->attr.pointer
+	 && !sym->attr.allocatable
+	 && sym->ts.type != BT_CLASS
+	 && sym->ts.type != BT_ASSUMED
+	 && sym->as
+	 && (sym->as->type == AS_ASSUMED_SHAPE
+	     || sym->as->type == AS_ASSUMED_RANK);
+}
+
+
 gfc_symbol *
 gfc_find_dt_in_generic (gfc_symbol *sym)
 {
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index f3c9b815dd6..348039a0907 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -458,7 +458,8 @@ gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head)
 }
 
 
-/* Returns true if the expression is an array pointer.  */
+/* Returns true if the expression is an array pointer.  The tree must be a
+   descriptor.  */
 
 static bool
 is_pointer_array (tree expr)
@@ -480,7 +481,7 @@ is_pointer_array (tree expr)
       && GFC_DECL_PTR_ARRAY_P (TREE_OPERAND (expr, 0)))
     return true;
 
-  /* The field declaration is marked as an pointer array.  */
+  /* The field declaration is marked as a pointer array.  */
   if (TREE_CODE (expr) == COMPONENT_REF
       && GFC_DECL_PTR_ARRAY_P (TREE_OPERAND (expr, 1))
       && !GFC_CLASS_TYPE_P (TREE_TYPE (TREE_OPERAND (expr, 1))))
@@ -490,6 +491,29 @@ is_pointer_array (tree expr)
 }
 
 
+/* If the elements of the array are spaced by the span of its descriptor,
+   return the decl that provides that span, otherwise NULL_TREE.  This is
+   either a descriptor or the local decl of a descriptorless dummy array,
+   which keeps the descriptor it was built from as the saved one.  */
+
+static tree
+span_addressed_array (tree expr)
+{
+  if (is_pointer_array (expr))
+    return expr;
+
+  if (VAR_P (expr)
+      && GFC_DECL_PTR_ARRAY_P (expr)
+      && !GFC_DECL_CLASS (expr)
+      && GFC_ARRAY_TYPE_P (TREE_TYPE (expr))
+      && DECL_LANG_SPECIFIC (expr)
+      && GFC_DECL_SAVED_DESCRIPTOR (expr))
+    return expr;
+
+  return NULL_TREE;
+}
+
+
 /* 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
@@ -554,18 +578,13 @@ gfc_get_array_span (tree desc, gfc_expr *expr)
   gfc_symbol *sym = (expr && expr->expr_type == EXPR_VARIABLE) ?
 		    expr->symtree->n.sym : NULL;
 
-  if (is_pointer_array (desc)
+  if (span_addressed_array (desc)
       || (get_CFI_desc (NULL, expr, &desc, NULL)
 	  && (POINTER_TYPE_P (TREE_TYPE (desc))
 	      ? GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (desc)))
 	      : GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))))
-    {
-      if (POINTER_TYPE_P (TREE_TYPE (desc)))
-	desc = build_fold_indirect_ref_loc (input_location, desc);
-
-      /* This will have the span field set.  */
-      tmp = gfc_conv_descriptor_span_get (desc);
-    }
+    /* This will have the span field set.  */
+    tmp = gfc_conv_descriptor_span_get (gfc_get_span_descriptor (desc));
   else if (expr->ts.type == BT_ASSUMED)
     {
       if (DECL_LANG_SPECIFIC (desc) && GFC_DECL_SAVED_DESCRIPTOR (desc))
@@ -3964,7 +3983,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar,
   /* A pointer array component can be detected from its field decl. Fix
      the descriptor, mark the resulting variable decl and pass it to
      gfc_build_array_ref.  */
-  if (is_pointer_array (info->descriptor)
+  if (span_addressed_array (info->descriptor)
       || (expr && expr->ts.deferred && info->descriptor
 	  && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (info->descriptor))))
     {
@@ -4217,11 +4236,9 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
   if (get_CFI_desc (sym, expr, &decl, ar))
     decl = build_fold_indirect_ref_loc (input_location, decl);
   if (!expr->ts.deferred && !sym->attr.codimension
-      && is_pointer_array (se->expr))
+      && span_addressed_array (se->expr))
     {
-      if (TREE_CODE (se->expr) == COMPONENT_REF)
-	decl = se->expr;
-      else if (INDIRECT_REF_P (se->expr))
+      if (INDIRECT_REF_P (se->expr))
 	decl = TREE_OPERAND (se->expr, 0);
       else
 	decl = se->expr;
@@ -7595,7 +7612,13 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset,
 	return;
     }
 
-  tmp = build_array_ref (desc, offset, NULL, NULL);
+  /* An array whose elements are spaced by the span needs pointer arithmetic
+     to reference an element.  */
+  tmp = build_array_ref (desc, offset, span_addressed_array (desc), NULL);
+
+  /* A spanned character element is referenced by a pointer.  */
+  if (POINTER_TYPE_P (TREE_TYPE (tmp)) && span_addressed_array (desc))
+    tmp = build_fold_indirect_ref_loc (input_location, tmp);
 
   /* Offset the data pointer for pointer assignments from arrays with
      subreferences; e.g. my_integer => my_type(:)%integer_component.  */
@@ -8058,6 +8081,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 
       subref_array_target = (is_subref_array (expr)
 			     && (se->direct_byref
+				 || se->force_no_tmp
 				 || expr->ts.type == BT_CHARACTER));
       need_tmp = (gfc_ref_needs_temporary_p (expr->ref)
 		  && !subref_array_target);
@@ -8087,6 +8111,13 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
       else
 	full = gfc_full_array_ref_p (info->ref, NULL);
 
+      /* A subobject of the array elements is described by a new descriptor,
+	 whose element type is that of the subobject and whose span is the
+	 element size of the array.  */
+      if (subref_array_target && !se->direct_byref
+	  && info->ref && info->ref->next)
+	full = 0;
+
       if (full && !transposed_dims (ss))
 	{
 	  if (se->direct_byref && !se->byref_noassign)
@@ -8408,8 +8439,10 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 	}
       else
 	{
-	  /* Otherwise make a new one.  */
-	  if (expr->ts.type == BT_CHARACTER)
+	  /* Otherwise make a new one.  The element type is that of the
+	     subobject for a subreference of the array.  */
+	  if (expr->ts.type == BT_CHARACTER
+	      || (subref_array_target && !se->direct_byref))
 	    parmtype = gfc_typenode_for_spec (&expr->ts);
 	  else
 	    parmtype = gfc_get_element_type (TREE_TYPE (desc));
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 47b28c1d003..715dd1fd5c9 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1408,6 +1408,11 @@ 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.  */
+  if (gfc_is_span_addressed_dummy (sym) && packed == PACKED_NO)
+    GFC_DECL_PTR_ARRAY_P (decl) = 1;
+
   if (sym->ns->proc_name->backend_decl == current_function_decl
       || sym->attr.contained)
     gfc_add_decl_to_function (decl);
@@ -1786,7 +1791,8 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	  && sym->attr.allocatable)
 	gfc_defer_symbol_init (sym);
 
-      if (sym->attr.pointer && sym->attr.dimension && sym->ts.type != BT_CLASS)
+      if ((sym->attr.pointer && sym->attr.dimension && sym->ts.type != BT_CLASS)
+	  || gfc_is_span_addressed_dummy (sym))
 	GFC_DECL_PTR_ARRAY_P (sym->backend_decl) = 1;
 
       /* Create a character length variable.  */
@@ -2078,6 +2084,20 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	   && !sym->attr.subref_array_pointer))
     GFC_DECL_PTR_ARRAY_P (decl) = 1;
 
+  /* A SELECT RANK temporary uses a copy of the selector's descriptor.
+     Its elements may be spaced by more than the element size,
+     so use copied span as well.  */
+  if (sym->attr.select_rank_temporary && sym->attr.dimension
+      && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))
+      && sym->assoc && sym->assoc->target
+      && sym->assoc->target->expr_type == EXPR_VARIABLE)
+    {
+      gfc_symbol *sel = sym->assoc->target->symtree->n.sym;
+      if (!sel->attr.contiguous
+	  && (sel->attr.target || sel->attr.pointer || sel->ts.type == BT_CLASS))
+	GFC_DECL_PTR_ARRAY_P (decl) = 1;
+    }
+
   if (sym->ts.type == BT_CLASS)
     GFC_DECL_CLASS(decl) = 1;
 
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 33b7838f74a..8a72aafb016 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -837,6 +837,8 @@ gfc_class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc,
 
   gfc_conv_descriptor_dtype_set (block, lhs_desc,
 				 gfc_conv_descriptor_dtype_get (rhs_desc));
+  gfc_conv_descriptor_span_set (block, lhs_desc,
+				gfc_conv_descriptor_span_get (rhs_desc));
 
   /* Assign the dimension as range-ref.  */
   lhs_dim = gfc_get_descriptor_dimension (lhs_desc);
@@ -6233,14 +6235,12 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
       else
 	gfc_conv_expr_descriptor (&se, e);
       gfc = se.expr;
-      /* For dt(:)%var the elem_len*stride != sm, hence, GFC uses
-	 elem_len = sizeof(dt) and base_addr = dt(lb) instead.
-	 gfc_get_dataptr_offset fixes the base_addr; for elem_len, see below.
-	 While sm is fine as it uses span*stride and not elem_len.  */
+      /* For dt(:)%var, the base_addr is that of the subobject and elem_len is
+	 its size, see below.  The descriptor built for a subreference of the
+	 array provides both.  While sm is fine as it uses span*stride and not
+	 elem_len.  */
       if (POINTER_TYPE_P (TREE_TYPE (gfc)))
 	gfc = build_fold_indirect_ref_loc (input_location, gfc);
-      else if (is_subref_array (e) && e->ts.type != BT_CHARACTER)
-	 gfc_get_dataptr_offset (&se.pre, gfc, gfc, NULL, true, e);
     }
   if (e->ts.type == BT_CHARACTER)
     {
@@ -6954,6 +6954,48 @@ conv_null_actual (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym)
 }
 
 
+/* Return true if a subobject of the elements of an array is referenced.  */
+
+static bool
+is_subobject_ref (gfc_expr *e)
+{
+  bool seen_array = false;
+
+  for (gfc_ref *ref = e->ref; ref; ref = ref->next)
+    {
+      if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
+	seen_array = true;
+      else if (seen_array)
+	return true;
+    }
+
+  return false;
+}
+
+
+/* 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
+   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
+   association is undefined on return, so it is still copied.  */
+
+static bool
+copy_in_out_allowed (gfc_symbol *fsym, gfc_expr *e, bool nodesc_arg)
+{
+  if (fsym == NULL || nodesc_arg || gfc_has_vector_subscript (e))
+    return true;
+
+  if (gfc_is_span_addressed_dummy (fsym))
+    return false;
+
+  return !(fsym->attr.pointer && !fsym->attr.contiguous && fsym->as
+	   && (fsym->as->type == AS_ASSUMED_SHAPE
+	       || fsym->as->type == AS_ASSUMED_RANK
+	       || fsym->as->type == AS_DEFERRED));
+}
+
+
 /* Generate code for a procedure call.  Note can return se->post != NULL.
    If se->direct_byref is set then se->expr contains the return parameter.
    Return nonzero, if the call has alternate specifiers.
@@ -7985,14 +8027,20 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 
 	      else if (e->expr_type == EXPR_VARIABLE
 		    && is_subref_array (e)
-		    && !(fsym && fsym->attr.pointer))
+		    && !(fsym && fsym->attr.pointer)
+		    && copy_in_out_allowed (fsym, e, nodesc_arg))
 		/* The actual argument is a component reference to an
 		   array of derived types.  In this case, the argument
 		   is converted to a temporary, which is passed and then
-		   written back after the procedure call.  */
+		   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,
 				fsym ? fsym->attr.intent : INTENT_INOUT,
-				fsym && fsym->attr.pointer);
+				fsym && fsym->attr.pointer, fsym, sym->name,
+				NULL,
+				gfc_is_span_addressed_dummy (e->symtree->n.sym)
+				&& !is_subobject_ref (e));
 
 	      else if (e->ts.type == BT_CLASS && CLASS_DATA (e)->as
 		       && CLASS_DATA (e)->as->type == AS_ASSUMED_SIZE
@@ -8004,20 +8052,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		parmse.expr = e->symtree->n.sym->backend_decl;
 
 	      else if (gfc_is_class_array_ref (e, NULL)
-		       && fsym && fsym->ts.type == BT_DERIVED)
+		       && fsym && fsym->ts.type == BT_DERIVED
+		       && copy_in_out_allowed (fsym, e, nodesc_arg))
 		/* The actual argument is a component reference to an
 		   array of derived types.  In this case, the argument
 		   is converted to a temporary, which is passed and then
-		   written back after the procedure call.
-		   OOP-TODO: Insert code so that if the dynamic type is
-		   the same as the declared type, copy-in/copy-out does
-		   not occur.  */
+		   written back after the procedure call.  */
 		gfc_conv_subref_array_arg (&parmse, e, nodesc_arg,
 					   fsym->attr.intent,
 					   fsym->attr.pointer);
 
 	      else if (gfc_is_class_array_function (e)
-		       && fsym && fsym->ts.type == BT_DERIVED)
+		       && fsym && fsym->ts.type == BT_DERIVED
+		       && copy_in_out_allowed (fsym, e, nodesc_arg))
 		/* See previous comment.  For function actual argument,
 		   the write out is not needed so the intent is set as
 		   intent in.  */
@@ -8038,10 +8085,17 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 					     fsym->attr.pointer);
 		}
 	      else
-		/* This is where we introduce a temporary to store the
-		   result of a non-lvalue array expression.  */
-		gfc_conv_array_parameter (&parmse, e, nodesc_arg, fsym,
-					  sym->name, NULL);
+		{
+		  /* Having declined copy-in/copy-out above, a subobject of an
+		     array is described by a spanned descriptor.  */
+		  if (e->expr_type == EXPR_VARIABLE && is_subref_array (e))
+		    parmse.force_no_tmp = 1;
+
+		  /* This is where we introduce a temporary to store the
+		     result of a non-lvalue array expression.  */
+		  gfc_conv_array_parameter (&parmse, e, nodesc_arg, fsym,
+					    sym->name, NULL);
+		}
 
 	      /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
 		 allocated on entry, it must be deallocated.
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 5e3681da467..a76d9bb4325 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -2385,9 +2385,10 @@ gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg)
       se->expr = cond;
     }
 
-  /* A pointer that does not have the CONTIGUOUS attribute needs to be checked
-     if it points to an array whose span differs from the element size.  */
-  if (as && sym && IS_POINTER(sym) && !sym->attr.contiguous)
+  /* 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)))
     {
       tree span = gfc_conv_descriptor_span_get (desc);
       tmp = fold_convert (TREE_TYPE (span),
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index cf37261673c..c2ad65c9a74 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -389,6 +389,27 @@ gfc_build_addr_expr (tree type, tree t)
 }
 
 
+/* Return the descriptor that carries the span of DECL, which is marked as a
+   pointer array.  Such a decl usually is a descriptor.  The local decl of a
+   descriptorless dummy array is not, so its span comes from the descriptor it
+   was built from, which is the saved one.  */
+
+tree
+gfc_get_span_descriptor (tree decl)
+{
+  if (DECL_P (decl)
+      && GFC_ARRAY_TYPE_P (TREE_TYPE (decl))
+      && DECL_LANG_SPECIFIC (decl)
+      && GFC_DECL_SAVED_DESCRIPTOR (decl))
+    decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
+
+  if (POINTER_TYPE_P (TREE_TYPE (decl)))
+    decl = build_fold_indirect_ref_loc (input_location, decl);
+
+  return decl;
+}
+
+
 static tree
 get_array_span (tree type, tree decl)
 {
@@ -409,7 +430,9 @@ get_array_span (tree type, tree decl)
       && (TREE_CODE (type) == ARRAY_TYPE || TREE_CODE (type) == INTEGER_TYPE)
       && TYPE_STRING_FLAG (type))
     {
-      if (TREE_CODE (decl) == PARM_DECL)
+      if (DECL_P (decl) && GFC_DECL_PTR_ARRAY_P (decl))
+	decl = gfc_get_span_descriptor (decl);
+      else if (TREE_CODE (decl) == PARM_DECL)
 	decl = build_fold_indirect_ref_loc (input_location, decl);
       if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
 	span = gfc_conv_descriptor_span_get (decl);
@@ -449,11 +472,7 @@ get_array_span (tree type, tree decl)
 	  span = gfc_resize_class_size_with_len (NULL, decl, span);
 	}
       else if (GFC_DECL_PTR_ARRAY_P (decl))
-	{
-	  if (TREE_CODE (decl) == PARM_DECL)
-	    decl = build_fold_indirect_ref_loc (input_location, decl);
-	  span = gfc_conv_descriptor_span_get (decl);
-	}
+	span = gfc_conv_descriptor_span_get (gfc_get_span_descriptor (decl));
       else
 	span = NULL_TREE;
     }
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 0bdee5820fd..408acf081f1 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -641,6 +641,9 @@ tree gfc_build_array_ref (tree, tree, tree,
 /* Build an array ref using pointer arithmetic.  */
 tree gfc_build_spanned_array_ref (tree base, tree offset, tree span);
 
+/* Return the descriptor holding the span of a pointer array decl.  */
+tree gfc_get_span_descriptor (tree);
+
 /* Creates a label.  Decl is artificial if label_id == NULL_TREE.  */
 tree gfc_build_label_decl (tree);
 
diff --git a/gcc/testsuite/gfortran.dg/c_loc_test_22.f90 b/gcc/testsuite/gfortran.dg/c_loc_test_22.f90
index 7b1149aaa45..91547e8e337 100644
--- a/gcc/testsuite/gfortran.dg/c_loc_test_22.f90
+++ b/gcc/testsuite/gfortran.dg/c_loc_test_22.f90
@@ -17,7 +17,9 @@ 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" } }
-! { 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" } }
+! 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" } }
 
 ! { 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_5.f90 b/gcc/testsuite/gfortran.dg/class_to_type_5.f90
new file mode 100644
index 00000000000..ad299db514d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_to_type_5.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+! PR 53800
+
+! Check that a CLASS array with an extended dynamic type passed to an
+! assumed-shape TYPE dummy aliases the original storage, rather
+! than a copy-in/copy-out temporary that goes stale after return.
+!
+! Reported by Tobias Burnus  <[email protected]>
+
+program class_to_type
+  implicit none
+  type t
+    integer :: i
+  end type t
+  type, extends(t) :: t2
+    integer :: j
+  end type t2
+  class(t), target, allocatable :: a(:,:)
+  type(t), pointer :: ptr
+
+  allocate (t2 :: a(5,5))
+  a(:,:)%i = 53
+  a(3,3)%i = 42
+  a(4,4)%i = 74
+
+  call f (a)
+  if (ptr%i /= 42) stop 1
+  a(3,3)%i = 999
+  if (ptr%i /= 999) stop 2
+contains
+  subroutine f(x)
+    type(t), target :: x(:,:)
+    ptr => x(3,3)
+  end subroutine f
+end program class_to_type
diff --git a/gcc/testsuite/gfortran.dg/class_to_type_6.f90 b/gcc/testsuite/gfortran.dg/class_to_type_6.f90
new file mode 100644
index 00000000000..67d02c67fb8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_to_type_6.f90
@@ -0,0 +1,93 @@
+! { dg-do run }
+! PR53800
+
+! A CLASS array actual passed to an assumed-shape TYPE dummy only
+! aliases the actual's storage when the dummy has the TARGET attribute.
+!
+module m
+  implicit none
+  type :: t
+    integer :: i
+  end type
+  type, extends(t) :: t2
+    integer :: pad(4)
+  end type
+  type :: u
+    integer :: k
+  end type
+  type :: c
+    integer  :: i
+    type(u)  :: sub(3)
+  end type
+  type, extends(c) :: c2
+    integer :: pad(4)
+  end type
+contains
+  ! A dummy (non-target): copy-in/copy-out,
+  subroutine plain (x)
+    type(t) :: x(:)
+    if (any (x%i /= [1,2,3,4,5])) stop 1
+    call expl (x)
+    if (any (cshift (x%i, 1) /= [2,3,4,5,1])) stop 3
+    if (any (pack (x%i, [.true.,.false.,.true.,.false.,.true.]) &
+             /= [1,3,5])) stop 4
+    if (any (reshape (x%i, [1,5]) /= reshape ([1,2,3,4,5], [1,5]))) stop 5
+    call to_class (x)
+  end subroutine
+
+  subroutine expl (y)
+    type(t) :: y(5)
+    if (any (y%i /= [1,2,3,4,5])) stop 2
+  end subroutine
+
+  subroutine to_class (z)
+    class(t) :: z(:)
+    if (any (z%i /= [1,2,3,4,5])) stop 6
+  end subroutine
+
+  ! A component sub-array of a span-carrying dummy has its own element
+  ! size and must not inherit the parent's span.
+  subroutine comp (x)
+    type(c), target :: x(:)
+    call inner (x(2)%sub)
+  end subroutine
+
+  subroutine inner (s)
+    type(u) :: s(:)
+    if (any (s%k /= [21,22,23])) stop 7
+  end subroutine
+end module
+
+program class_to_type_6
+  use m
+  implicit none
+  class(t), target, allocatable :: a(:)
+  class(c), target, allocatable :: b(:)
+  type(t), pointer :: p
+  integer :: n
+
+  allocate (t2 :: a(5))
+  do n = 1, 5
+    a(n)%i = n
+  end do
+  call plain (a)
+
+  allocate (c2 :: b(3))
+  do n = 1, 3
+    b(n)%i = 10 * n
+    b(n)%sub(:)%k = [10*n+1, 10*n+2, 10*n+3]
+  end do
+  call comp (b)
+
+  ! A TARGET assumed-shape dummy without CONTIGUOUS does alias.
+  call aliased (a)
+  if (p%i /= 3) stop 8
+  a(3)%i = 999
+  if (p%i /= 999) stop 9
+
+contains
+  subroutine aliased (x)
+    type(t), target :: x(:)
+    p => x(3)
+  end subroutine
+end program
diff --git a/gcc/testsuite/gfortran.dg/class_to_type_7.f90 b/gcc/testsuite/gfortran.dg/class_to_type_7.f90
new file mode 100644
index 00000000000..c5f74809c46
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_to_type_7.f90
@@ -0,0 +1,151 @@
+! { dg-do run }
+! PR fortran/53800
+
+! Further cases in which a dummy must be associated with the actual
+! argument's storage rather than a copy-in/copy-out temporary: an
+! intrinsic-type component of a CLASS array, a POINTER dummy and an
+! assumed-rank TARGET dummy.
+!
+! Variations contributed by Mikael Morin  <[email protected]>
+
+module m
+  implicit none
+  type t
+    integer :: i
+  end type t
+  type, extends(t) :: t2
+    integer :: j
+  end type t2
+end module m
+
+! An intrinsic-type component of a CLASS array to an INTEGER TARGET dummy.
+subroutine test_integer_component ()
+  use m
+  implicit none
+  class(t), target, allocatable :: a(:,:)
+  integer, pointer :: ptr
+
+  allocate (t2 :: a(5,5))
+  a(:,:)%i = 53
+  a(3,3)%i = 42
+
+  call f (a%i)
+  if (ptr /= 42) stop 1
+  a(3,3)%i = 999
+  if (ptr /= 999) stop 2
+contains
+  subroutine f(x)
+    integer, target :: x(:,:)
+    ptr => x(3,3)
+  end subroutine f
+end subroutine test_integer_component
+
+! A component of a plain derived-type array to an INTEGER TARGET dummy.
+subroutine test_subref_component ()
+  implicit none
+  type u
+    integer :: i
+    integer :: pad
+  end type u
+  type(u), target :: a(5,5)
+  integer, pointer :: ptr
+
+  a(:,:)%i = 53
+  a(3,3)%i = 42
+
+  call f (a%i)
+  if (ptr /= 42) stop 3
+  a(3,3)%i = 999
+  if (ptr /= 999) stop 4
+contains
+  subroutine f(x)
+    integer, target :: x(:,:)
+    ptr => x(3,3)
+  end subroutine f
+end subroutine test_subref_component
+
+! A character component of a derived-type array to a CHARACTER TARGET dummy.
+subroutine test_character_component ()
+  implicit none
+  type u
+    character(len=4) :: c
+    integer :: pad
+  end type u
+  type(u), target :: a(6)
+  character(len=4), pointer :: ptr
+  integer :: k
+
+  do k = 1, 6
+    a(k)%c = "ab00"
+  end do
+  a(4)%c = "zzzz"
+
+  call f (a%c)
+  if (ptr /= "zzzz") stop 10
+  a(4)%c = "qqqq"
+  if (ptr /= "qqqq") stop 11
+contains
+  subroutine f(x)
+    character(len=4), target :: x(:)
+    ptr => x(4)
+  end subroutine f
+end subroutine test_character_component
+
+! A CLASS POINTER array to a TYPE POINTER dummy.
+subroutine test_pointer_dummy ()
+  use m
+  implicit none
+  class(t), pointer :: a(:,:)
+  type(t), pointer :: ptr
+
+  allocate (t2 :: a(5,5))
+  a(:,:)%i = 53
+  a(3,3)%i = 42
+
+  call f (a)
+  if (ptr%i /= 42) stop 5
+  a(3,3)%i = 999
+  if (ptr%i /= 999) stop 6
+  deallocate (a)
+contains
+  subroutine f(x)
+    type(t), pointer :: x(:,:)
+    ptr => x(3,3)
+  end subroutine f
+end subroutine test_pointer_dummy
+
+! A CLASS array to an assumed-rank TARGET dummy, selected with SELECT RANK.
+subroutine test_assumed_rank ()
+  use m
+  implicit none
+  class(t), target, allocatable :: a(:,:)
+  type(t), pointer :: ptr
+
+  allocate (t2 :: a(5,5))
+  a(:,:)%i = 53
+  a(3,3)%i = 42
+
+  call f (a)
+  if (ptr%i /= 42) stop 7
+  a(3,3)%i = 999
+  if (ptr%i /= 999) stop 8
+contains
+  subroutine f(x)
+    type(t), target :: x(..)
+    select rank (x)
+      rank (2)
+        ptr => x(3,3)
+      rank default
+        error stop 9
+    end select
+  end subroutine f
+end subroutine test_assumed_rank
+
+program class_to_type_7
+  implicit none
+  call test_integer_component ()
+  call test_subref_component ()
+  call test_character_component ()
+  call test_pointer_dummy ()
+  call test_assumed_rank ()
+end program class_to_type_7
diff --git a/gcc/testsuite/gfortran.dg/class_to_type_8.f90 b/gcc/testsuite/gfortran.dg/class_to_type_8.f90
new file mode 100644
index 00000000000..48851d42cd1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_to_type_8.f90
@@ -0,0 +1,47 @@
+! { dg-do run }
+! PR fortran/53800
+
+! A component of an array of extended derived types, passed to a TARGET
+! dummy, is addressed through the span of its descriptor.  This must also
+! hold for a section of such a dummy and for a subobject reference applied
+! to it.
+!
+! Contributed by Mikael Morin  <[email protected]>
+
+program p
+  implicit none
+  type :: t
+    integer :: c1, c2
+  end type
+  type, extends(t) :: u
+    integer :: c3
+  end type
+  type, extends(u) :: v
+    integer :: c4
+  end type
+  type(v), target :: x(12)
+  integer :: i
+  x = [(v(i,i*i,i,i), i=1,size(x))]
+  call s1(x(2::3)%c2, 1)
+  call s2(x%u)
+contains
+  subroutine s1(a, error_idx)
+    integer, intent(in) :: error_idx
+    integer, target :: a(:)
+    if (any(a /= [4, 25, 64, 121])) error stop error_idx * 10 + 1
+  end subroutine
+  subroutine s2(a)
+    type(u), target :: a(:)
+    if (any(a%c2 /= [(i*i, i=1,12)])) error stop 2
+    if (any(a(2::3)%c2 /= [4, 25, 64, 121])) error stop 3
+    call s1(a(2::3)%c2, 2)
+    call s3(a(2::3)%c2)
+    if (any(x(2::3)%c2 /= [-4, -25, -64, -121])) error stop 5
+    x = [(v(i,i*i,i,i), i=1,size(x))]
+  end subroutine
+  subroutine s3(a)
+    integer :: a(:)          ! copy-in/copy-out
+    if (any(a /= [4, 25, 64, 121])) error stop 4
+    a = -a
+  end subroutine
+end program
diff --git a/gcc/testsuite/gfortran.dg/class_to_type_9.f90 b/gcc/testsuite/gfortran.dg/class_to_type_9.f90
new file mode 100644
index 00000000000..40f4e6a53de
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_to_type_9.f90
@@ -0,0 +1,67 @@
+! { dg-do run }
+! PR fortran/53800
+
+! 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.
+
+module m
+  implicit none
+  type :: t
+    integer :: c1, c2
+  end type
+  integer, pointer :: saved(:) => null()
+contains
+  subroutine chk(a, opt)
+    integer, target :: a(:)
+    integer, optional, target :: opt(:)
+    character(24) :: line
+    if (is_contiguous(a)) stop 1
+    if (present(opt)) stop 2
+    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_size(a)
+    saved => a
+    a(2) = -a(2)
+  end subroutine
+  subroutine packed(b)         ! copy-in/copy-out
+    integer :: b(:)
+    if (any(b /= [1, 4, 9, 16])) stop 5
+    if (.not. is_contiguous(b)) stop 6
+  end subroutine
+  subroutine assumed_size(c)   ! no descriptor
+    integer :: c(*)
+    if (any(c(1:4) /= [1, 4, 9, 16])) stop 7
+  end subroutine
+  subroutine rank_any(d)
+    integer, target :: d(..)
+    select rank (d)
+    rank (1)
+      if (any(d /= [1, 2, 3, 4])) stop 8
+      saved => d
+    rank default
+      stop 9
+    end select
+  end subroutine
+end module
+
+program p
+  use m
+  implicit none
+  type(t), target :: x(4)
+  integer :: i
+  x = [(t(i, i*i), i=1,4)]
+
+  call chk(x%c2)
+  if (any(x%c2 /= [1, -4, 9, 16])) stop 10
+  saved = 0
+  if (any(x%c2 /= [0, 0, 0, 0])) stop 11
+  if (any(x%c1 /= [1, 2, 3, 4])) stop 12
+
+  call rank_any(x%c1)
+  saved = 7
+  if (any(x%c1 /= [7, 7, 7, 7])) stop 13
+end program
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/host_data-5.F90 b/libgomp/testsuite/libgomp.oacc-fortran/host_data-5.F90
index c3453a579ae..ae5104beb48 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/host_data-5.F90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/host_data-5.F90
@@ -74,10 +74,17 @@ subroutine foo (p2, parr, host_p, host_parr, cond)
     ! { dg-note {variable 'host_p\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-5 }
     ! { dg-note {variable 'host_parr\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-6 }
     ! { dg-note {variable 'C\.[0-9]+' declared in block potentially has improper OpenACC privatization level: 'const_decl'} "TODO" { target *-*-* } .-7 }
-    ! { dg-note {variable 'parm\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: artificial} "" { target *-*-* } .-8 }
-    ! { dg-note {variable 'D\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: artificial} "" { target *-*-* } .-9 }
-    ! { dg-note {variable 'transfer\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: artificial} "" { target *-*-* } .-10 }
-    ! { dg-note {variable 'parm\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-11 }
+    ! { dg-note {variable 'D\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: artificial} "" { target *-*-* } .-8 }
+    ! { dg-note {variable 'transfer\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: artificial} "" { target *-*-* } .-9 }
+    ! { dg-note {variable 'parm\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-10 }
+    ! The TARGET dummy 'parr' is addressed by the span of its descriptor, so
+    ! passing it to a dummy without a descriptor packs it when it is not
+    ! contiguous.
+    ! { dg-note {variable 'iftmp\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-14 }
+    ! { dg-note {variable 'atmp\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-15 }
+    ! { dg-note {variable 'arg_ptr\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-16 }
+    ! { dg-note {variable 'contiguous\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-17 }
+    ! { dg-note {variable 'S\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-18 }
       if (.not. acc_is_present(p, c_sizeof(p))) stop 11
       if (.not. acc_is_present(parr, 1)) stop 12
       ! Not inside a host_data construct, so still the host pointer.
-- 
2.55.0