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

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.

Assisted by: Claude Sonnet 4.6

	PR fortran/60576

gcc/fortran/ChangeLog:

	PR fortran/60576
	* 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:

	PR fortran/60576
	* 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.

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 3e3f4f00b25583b943fef7e836b27353d00cb4b0..6c8167e1b15dc46ece55242adff0918e2876cfb5 100644 (file)
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9505,7 +9505,43 @@ 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)
+           {
+             /* 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.  PR fortran/60576.  */
+             tree rank, dim_field, dim_size, copy_size, dst_ptr, src_ptr;
+
+             gfc_conv_descriptor_data_set (&block, tmp,
+                                           gfc_conv_descriptor_data_get (se->expr));
+             gfc_conv_descriptor_offset_set (&block, tmp,
+                                             gfc_conv_descriptor_offset_get (se->expr));
+             gfc_add_modify (&block, gfc_conv_descriptor_dtype (tmp),
+                             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 (tmp));
+             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 if (CLASS_DATA (fsym)->as->rank == -1)
+           /* Fixed-rank actual to class assumed-rank formal: the formal's
+              class descriptor has dim_t[GFC_MAX_DIMENSIONS]; use lhs_type=false
+              so the ARRAY_RANGE_REF is sized by TREE_TYPE(rhs_dim) = dim_t[rank],
+              copying only the physically present entries.  PR fortran/60576. */
+           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 e64ffc12b713412dbd846033e035f0e9fd40e760..c808c1b3ef32a5253e1c213fbe0a02982d40276e 100644 (file)
--- 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 (file)
index 0000000..d2a0e10
--- /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