https://gcc.gnu.org/g:eaf4292c83804bd21b920db174401ca3702601d4
commit r17-1352-geaf4292c83804bd21b920db174401ca3702601d4 Author: Jerry DeLisle <[email protected]> Date: Thu Jun 4 12:11:37 2026 -0700 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: --- gcc/fortran/trans-array.cc | 38 ++++++++++++++++++++- gcc/fortran/trans-expr.cc | 34 ++++++++++++++++++- gcc/testsuite/gfortran.dg/asan/assumed_rank_26.f90 | 39 ++++++++++++++++++++++ 3 files changed, 109 insertions(+), 2 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 3e3f4f00b255..6c8167e1b15d 100644 --- 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 e64ffc12b713..c808c1b3ef32 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
