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

commit r16-9162-gf7741ff940026aaa85599778d611c2bb4fcd6092
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 eaf4292c83804bd21b920db174401ca3702601d4)

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 ba8753199d94..5c26ec82d3e8 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9291,6 +9291,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
@@ -9565,7 +9593,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 c1f8b9b54d42..0dbf0e4be9fc 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1028,7 +1028,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

Reply via email to