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 <[email protected]>
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 <[email protected]>
+
+! 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
