On 6/3/26 11:54 PM, Paul Richard Thomas wrote:
Hello Jerry,Contrary to my remark on Mattermost, this looks good to me except that I would halve the size of the patch by refactoring it as in the attached version. It passes regression testing like the original. OK for mainline and backporting later on. Thanks for re-examining this Golden Oldie! Paul
Paul, the diff you attached threw claude into a tizzy. I slapped it and set it back on track. The attached fixes the breakage in the original assumed_rank_7.f90 with -fsanitize=address, passes the new asan/assumed_rank_26.f90 and fixed a breakage in coarray/dummy_3.f90.
I have completely regression tested this one and manually tested the original assume_rank_7.f90 with -fsanitize=address. All pass.
I plan to commit this shortly. Regards, Jerry
From bac03f50d8c83a91c16fb8306ce0f5048c549c43 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle <[email protected]> Date: Thu, 4 Jun 2026 12:11:37 -0700 Subject: [PATCH] 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. --- gcc/fortran/trans-array.cc | 38 +++++++++++++++++- gcc/fortran/trans-expr.cc | 34 +++++++++++++++- .../gfortran.dg/asan/assumed_rank_26.f90 | 39 +++++++++++++++++++ 3 files changed, 109 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/asan/assumed_rank_26.f90 diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 3e3f4f00b25..6c8167e1b15 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 e64ffc12b71..c808c1b3ef3 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 00000000000..d2a0e10a047 --- /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 -- 2.54.0
