Hi all, I somehow got assigned to this PR so I fixed it. GFortran was ICEing because of the ASSUME_RANK in a derived to class conversion. After fixing this, storage association was producing segfaults. The "shape conversion" of the class array as dummy argument was not initializing the dim 0 stride and with that grabbing into the memory somewhere. This is now fixed and
regtests fine on x86_64 Fedora 39. Ok for mainline? I assume this patch could be fixing some other PRs with class array's parameter passing, too. If that sounds familiar, feel free to point me to them. Regards, Andre -- Andre Vehreschild * Email: vehre ad gmx dot de
From 86ac3179e1314ca1c41f52025c5a156ad7346dc1 Mon Sep 17 00:00:00 2001 From: Andre Vehreschild <ve...@gcc.gnu.org> Date: Fri, 14 Jun 2024 16:54:37 +0200 Subject: [PATCH] Fortran: [PR96992] Fix rejecting class arrays of different ranks as storage association argument. Removing the assert in trans-expr, lead to initial strides not set which is not fixed. PR fortran/96992 gcc/fortran/ChangeLog: * trans-array.cc (gfc_trans_array_bounds): Set a starting stride, when descriptor expects a variable for the stride. (gfc_trans_dummy_array_bias): Allow storage association for dummy class arrays, when they are not elemental. * trans-expr.cc (gfc_conv_derived_to_class): Remove assert to allow converting derived to class type arrays with assumend rank. gcc/testsuite/ChangeLog: * gfortran.dg/pr96992.f90: New test. --- gcc/fortran/trans-array.cc | 7 ++- gcc/fortran/trans-expr.cc | 2 - gcc/testsuite/gfortran.dg/pr96992.f90 | 61 +++++++++++++++++++++++++++ 3 files changed, 67 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr96992.f90 diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index b3088a892c8..9fa8bad2f35 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -6798,6 +6798,9 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset, size = gfc_index_one_node; offset = gfc_index_zero_node; + stride = GFC_TYPE_ARRAY_STRIDE (type, 0); + if (stride && VAR_P (stride)) + gfc_add_modify (pblock, stride, gfc_index_one_node); for (dim = 0; dim < as->rank; dim++) { /* Evaluate non-constant array bound expressions. @@ -7134,7 +7137,9 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, || (is_classarray && CLASS_DATA (sym)->attr.allocatable)) return; - if (!is_classarray && sym->attr.dummy && gfc_is_nodesc_array (sym)) + if ((!is_classarray + || (is_classarray && CLASS_DATA (sym)->as->type == AS_EXPLICIT)) + && sym->attr.dummy && !sym->attr.elemental && gfc_is_nodesc_array (sym)) { gfc_trans_g77_array (sym, block); return; diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 0796fb75505..4bb62cfb1ad 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -903,8 +903,6 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, if (e->rank != class_ts.u.derived->components->as->rank) { - gcc_assert (class_ts.u.derived->components->as->type - == AS_ASSUMED_RANK); if (derived_array && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (parmse->expr))) { diff --git a/gcc/testsuite/gfortran.dg/pr96992.f90 b/gcc/testsuite/gfortran.dg/pr96992.f90 new file mode 100644 index 00000000000..c56ed80f394 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr96992.f90 @@ -0,0 +1,61 @@ +! { dg-do run } + +! PR fortran/96992 + +! Contributed by Thomas Koenig <tkoe...@gcc.gnu.org> + +! From the standard: +! An actual argument that represents an element sequence and +! corresponds to a dummy argument that is an array is sequence +! associated with the dummy argument. The rank and shape of the +! actual argument need not agree with the rank and shape of the +! dummy argument, but the number of elements in the dummy argument +! shall not exceed the number of elements in the element sequence +! of the actual argument. If the dummy argument is assumed-size, +! the number of elements in the dummy argument is exactly +! the number of elements in the element sequence. + +! Check that walking the sequence starts with an initialized stride +! for dim == 0. + +module foo_mod + implicit none + type foo + integer :: i + end type foo +contains + subroutine d1(x,n) + integer, intent(in) :: n + integer :: i + class (foo), intent(out), dimension(n) :: x + select type(x) + class is(foo) + x(:)%i = (/ (42 + i, i = 1, n ) /) + class default + stop 1 + end select + end subroutine d1 + subroutine d2(x,n) + integer, intent(in) :: n + integer :: i + class (foo), intent(in), dimension(n,n,n) :: x + select type (x) + class is (foo) + print *,x%i + if ( any( x%i /= reshape((/ (42 + i, i = 1, n ** 3 ) /), [n, n, n] ))) stop 2 + class default + stop 3 + end select + end subroutine d2 +end module foo_mod +program main + use foo_mod + implicit none + type (foo), dimension(:), allocatable :: f + integer :: n + n = 3 + allocate (f(n*n*n)) + call d1(f,n*n*n) + call d2(f,n) +end program main + -- 2.45.1