https://gcc.gnu.org/g:b50a4440b91a31599365f3cda029c32b47e3544e
commit b50a4440b91a31599365f3cda029c32b47e3544e Author: Mikael Morin <[email protected]> Date: Tue Oct 20 14:46:44 2026 +0200 fortran: Fix copy from polymorphic pointer source in ALLOCATE [PR128033] Fortran-tested on aarch64-unknown-linux-gnu. OK for mainline and backports? -- >8 -- Fix two problems relating to the source argument of ALLOCATE statements. When the source is a pointer array, drop the forced temporary leading to a bogus copy, and to avoid regressing when the source is an array subreference, fix the retrieval of the array reference serving as source of bounds. To fix PR114024, r14-9160 introduced an automatic wrapping in parentheses of the allocate source expression, forcing the generation of a temporary and avoiding an internal error. That change causes a regression with polymorphic pointers, because the reference generated for the temporary array doesn't contain the class container as parent subreference, so the array indexing ends up being generated by the non-polymorphic fall back. As a consequence, indexing is off and the values copied are wrong. This change reverts that PR114024 fix. It doesn't solve the underlying problem in case the parentheses are explicitly present in the user code, but it at least fixes the much more common case where they are absent. Reverting means restoring the original problem which has to be fixed some other way. The problem is an assertion failure expecting all intermediary array references to be single element references in the walk to find the last element of the data reference chain. The assertion makes sense in the context of the allocated entity, but the same function is also used with the source expression as input. In the latter case, there can be subreferences coming after the main array reference, so it's not a surprise that the assertion triggers. In the first place, we shouldn't be looking for the last element in the reference chain, as there is no guarantee that is the one holding the array information. To fix this, we need to find the single non-element array reference in the chain of the source expression. There is the existing gfc_find_array_ref which does exactly that, except it returns a gfc_array_ref, not a gfc_ref. So the type of the main array ref pointer is changed from gfc_ref to gfc_array_ref, and all the accesses from the gfc_ref to the gfc_array_ref beneath it are factored to set the new pointer. PR fortran/114024 PR fortran/128033 gcc/fortran/ChangeLog: * trans-stmt.cc (gfc_trans_allocate): Remove automatic wrapping of array subreferences in a parentheses expression. * trans-array.cc (gfc_array_allocate): Find the single non-element array reference in the source expression instead of getting the last reference in the chain. Use a gfc_array_ref pointer instead of a gfc_ref pointer and simplify the references using it. gcc/testsuite/ChangeLog: * gfortran.dg/allocate_with_source_34.f90: New test. Diff: --- gcc/fortran/trans-array.cc | 30 +++++++------- gcc/fortran/trans-stmt.cc | 9 +--- .../gfortran.dg/allocate_with_source_34.f90 | 48 ++++++++++++++++++++++ 3 files changed, 65 insertions(+), 22 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 1a0415b4462c..97d68caa1909 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -6554,47 +6554,47 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, if (!dimension) gcc_assert (coarray); + gfc_array_ref *ar; if (ref->u.ar.type == AR_FULL && expr3 != NULL) { - gfc_ref *old_ref = ref; /* F08:C633: Array shape from expr3. */ - ref = expr3->ref; - - /* Find the last reference in the chain. */ - if (!retrieve_last_ref (&ref, &prev_ref)) + ar = gfc_find_array_ref (expr3, true); + if (!ar) { if (expr3->expr_type == EXPR_FUNCTION && gfc_expr_attr (expr3).dimension) - ref = old_ref; + ar = &ref->u.ar; else return false; } alloc_w_e3_arr_spec = true; } + else + ar = &ref->u.ar; /* Figure out the size of the array. */ - switch (ref->u.ar.type) + switch (ar->type) { case AR_ELEMENT: if (!coarray) { lower = NULL; - upper = ref->u.ar.start; + upper = ar->start; break; } /* Fall through. */ case AR_SECTION: - lower = ref->u.ar.start; - upper = ref->u.ar.end; + lower = ar->start; + upper = ar->end; break; case AR_FULL: - gcc_assert (ref->u.ar.as->type == AS_EXPLICIT + gcc_assert (ar->as->type == AS_EXPLICIT || alloc_w_e3_arr_spec); - lower = ref->u.ar.as->lower; - upper = ref->u.ar.as->upper; + lower = ar->as->lower; + upper = ar->as->upper; break; default: @@ -6617,8 +6617,8 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, later will mislead the generation of the array dimensions for allocatable/ pointer components in derived types. */ size = gfc_array_init_size (se->expr, alloc_w_e3_arr_spec ? expr->rank - : ref->u.ar.as->rank, - coarray ? ref->u.ar.as->corank : 0, + : ar->as->rank, + coarray ? ar->as->corank : 0, &offset, lower, upper, &se->pre, &set_descriptor_block, &overflow, expr3_elem_size, expr3, e3_arr_desc, diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc index 60db7fdba067..71dd2a92191c 100644 --- a/gcc/fortran/trans-stmt.cc +++ b/gcc/fortran/trans-stmt.cc @@ -6812,14 +6812,9 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate) vtab_needed = (al->expr->ts.type == BT_CLASS); gfc_init_se (&se, NULL); - /* When expr3 is a variable, i.e., a very simple expression, then - convert it once here. If one has a source expression that has - substring references, part-refs, or %re/%im inquiries, wrap the - entity in parentheses to force evaluation of the expression. */ - if (code->expr3->expr_type == EXPR_VARIABLE - && is_subref_array (code->expr3)) - code->expr3 = gfc_get_parentheses (code->expr3); + /* When expr3 is a variable, i.e., a very simple expression, then + convert it once here. */ if (code->expr3->expr_type == EXPR_VARIABLE || code->expr3->expr_type == EXPR_ARRAY || code->expr3->expr_type == EXPR_CONSTANT) diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_34.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_34.f90 new file mode 100644 index 000000000000..38d958fbcca9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocate_with_source_34.f90 @@ -0,0 +1,48 @@ +! { dg-do run } +! +! PR fortran/128033 +! Check that array allocation from polymorphic pointer source correctly +! implements the array copy. + +program prog + implicit none + integer, parameter :: n = 5 + type :: t1 + integer :: c1, c2 + end type + type, extends(t1) :: t2 + integer :: c3 + end type + type(t2), target :: a(n) + integer :: i + a = [ (t2(2*i*i+3, i*i+2, 3*i+5), i=1,n) ] + call sub(a) +contains + subroutine sub(x) + class(t1), pointer, intent(in) :: x(:) + class(t1), allocatable :: a(:) + allocate(a, source=x) + call check_all(x, 1) + call check_all(a, 2) + end subroutine + subroutine check_all(x, e) + class(t1), target, intent(in) :: x(:) + integer, intent(in) :: e + select type(x) + type is (t2) + call check(x%c1, [ 5, 11, 21, 35, 53], e*10+1) + call check(x%c2, [ 3, 6, 11, 18, 27], e*10+2) + call check(x%c3, [ 8, 11, 14, 17, 20], e*10+3) + class default + error stop e*10+7 + end select + end subroutine + subroutine check(x, y, e) + integer, target, dimension(:), intent(in) :: x, y + integer, intent(in) :: e + character(4) :: status + integer :: i + if (size(x) /= size(y)) error stop e*10+8 + if (any(x /= y)) error stop e*10+9 + end subroutine +end program
