[gcc r15-11361] Fortran:[PR60576] fix stack-buffer-overflow passing type to assumed-rank class

https://gcc.gnu.org/g:d413a277b544be4094670def2a18fc35f0f1a71c

commit r15-11361-gd413a277b544be4094670def2a18fc35f0f1a71c
Author: Jerry DeLisle <[email protected]>
Date:   Thu Jun 4 12:11:37 2026 -0700

    Fortran:[PR60576] fix stack-buffer-overflow passing type to assumed-rank class
    
    Two code paths copied a full GFC_MAX_DIMENSIONS dim[] array from a
    descriptor that physically holds only dtype.rank dimensions, triggering
    a stack-buffer-overflow detected by AddressSanitizer.
    
    Case 1 - assumed-rank type(T) dummy passed to class(T) assumed-rank:
    The caller only allocates storage for dtype.rank dimensions.  The code
    generated a static GFC_MAX_DIMENSIONS struct copy of the dim[] array,
    reading past the physical end of the descriptor.  Fix by checking
    expr->rank == -1 and replacing the static copy with a runtime-sized
    __builtin_memcpy of dtype.rank * sizeof(descriptor_dimension) bytes.
    
    Case 2 - fixed-rank type(T) actual passed directly to class(T) assumed-rank:
    gfortran uses a rank-specific descriptor type for fixed-rank type arrays
    (dim[rank] rather than dim[GFC_MAX_DIMENSIONS]).  The class assumed-rank
    formal's descriptor has dim_t[GFC_MAX_DIMENSIONS].  The call to
    gfc_class_array_data_assign with lhs_type=true keyed the ARRAY_RANGE_REF
    off TREE_TYPE(lhs_dim) = dim_t[GFC_MAX_DIMENSIONS], reading 15*24 = 360
    bytes from a descriptor that physically has only rank*24 bytes for the
    dim[] array.  Fix by checking CLASS_DATA(fsym)->as->rank == -1 and
    passing lhs_type=false so the ARRAY_RANGE_REF is sized by
    TREE_TYPE(rhs_dim) = dim_t[rank], copying only the physically present
    entries.  Fixed-rank class formals retain lhs_type=true.
    
            PR fortran/60576
    
    gcc/fortran/ChangeLog:
    
            * trans-array.cc (gfc_conv_array_parameter): For an assumed-rank
            actual argument passed to a CLASS assumed-rank formal, use a
            runtime-sized memcpy for the dim[] entries instead of a full
            GFC_MAX_DIMENSIONS static copy.  For a fixed-rank actual to a
            CLASS assumed-rank formal, pass lhs_type=false to
            gfc_class_array_data_assign so the dim[] copy is sized by the
            RHS descriptor type (dim_t[rank]).  Fixed-rank class formals
            retain lhs_type=true.
            * trans-expr.cc (gfc_conv_derived_to_class): For an assumed-rank
            actual, use a runtime-sized memcpy for the derived_array descriptor
            dim[] copy instead of a full GFC_MAX_DIMENSIONS static copy.
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/asan/assumed_rank_26.f90: New test covering both
            assumed-rank and fixed-rank type actuals passed to a CLASS
            assumed-rank dummy.
    
    (cherry picked from commit f7741ff940026aaa85599778d611c2bb4fcd6092)

Diff:
---
 gcc/fortran/trans-array.cc                         | 35 ++++++++++++++++++-
 gcc/fortran/trans-expr.cc                          | 34 ++++++++++++++++++-
 gcc/testsuite/gfortran.dg/asan/assumed_rank_26.f90 | 39 ++++++++++++++++++++++
 3 files changed, 106 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 33335dd551da..933da7bdc60d 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9045,6 +9045,34 @@ is_pointer (gfc_expr *e)
   return sym->attr.pointer || sym->attr.proc_pointer;
 }
 
+/* Assumed-rank actual argument: the caller only allocates storage for dtype
+   rank dimensions. Copying GFC_MAX_DIMENSIONS dim entries would read past the
+   physical end of the descriptor. Copy the header fields explicitly and use a
+   runtime-sized memcpy for the dim[] entries.  */
+void
+gfc_resize_assumed_rank_dim_field (gfc_se *se, stmtblock_t *block, tree desc)
+{
+  tree rank, dim_field, dim_size, copy_size, dst_ptr, src_ptr;
+
+  gfc_conv_descriptor_data_set (block, desc,
+				gfc_conv_descriptor_data_get (se->expr));
+  gfc_conv_descriptor_offset_set (block, desc,
+				  gfc_conv_descriptor_offset_get (se->expr));
+  gfc_add_modify (block, gfc_conv_descriptor_dtype (desc),
+		  gfc_conv_descriptor_dtype (se->expr));
+  rank = fold_convert (size_type_node, gfc_conv_descriptor_rank (se->expr));
+  dim_field = gfc_get_descriptor_dimension (se->expr);
+  dim_size = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (dim_field)));
+  copy_size = fold_build2_loc (input_location, MULT_EXPR,
+			       size_type_node, rank, dim_size);
+  dst_ptr = gfc_build_addr_expr (pvoid_type_node,
+				 gfc_get_descriptor_dimension (desc));
+  src_ptr = gfc_build_addr_expr (pvoid_type_node, dim_field);
+  gfc_add_expr_to_block (block, build_call_expr_loc (input_location,
+			 builtin_decl_explicit (BUILT_IN_MEMCPY),
+			 3, dst_ptr, src_ptr, copy_size));
+}
+
 /* Convert an array for passing as an actual parameter.  */
 
 void
@@ -9319,7 +9347,12 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77,
 	      gfc_conv_descriptor_offset_set (&block, arr, gfc_index_zero_node);
 	      se->expr = arr;
 	    }
-	  gfc_class_array_data_assign (&block, tmp, se->expr, true);
+	  if (expr->rank == -1)
+	    gfc_resize_assumed_rank_dim_field (se, &block, tmp);
+	  else if (CLASS_DATA (fsym)->as->rank == -1)
+	    gfc_class_array_data_assign (&block, tmp, se->expr, false);
+	  else
+	    gfc_class_array_data_assign (&block, tmp, se->expr, true);
 
 	  /* Handle optional.  */
 	  if (fsym && fsym->attr.optional && sym && sym->attr.optional)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 69cdede7db7a..18ec925c2ae2 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -961,7 +961,39 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym,
 	    {
 	      *derived_array
 		= gfc_create_var (TREE_TYPE (parmse->expr), "array");
-	      gfc_add_modify (&block, *derived_array, parmse->expr);
+	      if (e->rank == -1)
+		{
+		  /* Assumed-rank actual: parmse->expr physically holds only
+		     dtype.rank dims; a full struct assign reads past the end.
+		     Copy field-by-field with a runtime-sized dim[] memcpy.
+		     PR fortran/60576.  */
+		  tree rank, dim_field, dim_size, copy_size, dst_ptr, src_ptr;
+
+		  gfc_conv_descriptor_data_set
+		    (&block, *derived_array,
+		     gfc_conv_descriptor_data_get (parmse->expr));
+		  gfc_conv_descriptor_offset_set
+		    (&block, *derived_array,
+		     gfc_conv_descriptor_offset_get (parmse->expr));
+		  gfc_add_modify (&block,
+				  gfc_conv_descriptor_dtype (*derived_array),
+				  gfc_conv_descriptor_dtype (parmse->expr));
+		  rank = fold_convert (size_type_node,
+				       gfc_conv_descriptor_rank (parmse->expr));
+		  dim_field = gfc_get_descriptor_dimension (parmse->expr);
+		  dim_size = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (dim_field)));
+		  copy_size = fold_build2_loc (input_location, MULT_EXPR,
+					       size_type_node, rank, dim_size);
+		  dst_ptr = gfc_build_addr_expr
+		    (pvoid_type_node, gfc_get_descriptor_dimension (*derived_array));
+		  src_ptr = gfc_build_addr_expr (pvoid_type_node, dim_field);
+		  gfc_add_expr_to_block (&block,
+		      build_call_expr_loc (input_location,
+					   builtin_decl_explicit (BUILT_IN_MEMCPY),
+					   3, dst_ptr, src_ptr, copy_size));
+		}
+	      else
+		gfc_add_modify (&block, *derived_array, parmse->expr);
 	    }
 
 	  if (optional)
diff --git a/gcc/testsuite/gfortran.dg/asan/assumed_rank_26.f90 b/gcc/testsuite/gfortran.dg/asan/assumed_rank_26.f90
new file mode 100644
index 000000000000..d2a0e10a047c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/asan/assumed_rank_26.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+!
+! PR fortran/60576
+!
+! Stack buffer overflow when passing an assumed-rank type(T) dummy argument
+! to an assumed-rank class(T) dummy argument.  The caller only allocates
+! storage for dtype.rank dimensions in the descriptor; generating a full
+! GFC_MAX_DIMENSIONS copy caused a stack-buffer-overflow detected by ASan.
+
+implicit none
+type t
+  integer :: i
+end type
+
+type(T) :: at(2:3,2:4)
+integer :: i = 0
+
+call bar(at)
+if (i /= 2) STOP 1
+
+contains
+  subroutine bar(x)
+    type(t) :: x(..)
+    if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) STOP 2
+    if (size(x) /= 6) STOP 3
+    if (size(x,1) /= 2 .or. size(x,2) /= 3) STOP 4
+    if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) STOP 5
+    i = i + 1
+    call foo(x)
+  end subroutine
+  subroutine foo(x)
+    class(t) :: x(..)
+    if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) STOP 6
+    if (size(x) /= 6) STOP 7
+    if (size(x,1) /= 2 .or. size(x,2) /= 3) STOP 8
+    if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) STOP 9
+    i = i + 1
+  end subroutine
+end