https://gcc.gnu.org/g:9c6bfb7bd3c5c09d9dfdb08956a4cb3f1e3d8e6b
commit 9c6bfb7bd3c5c09d9dfdb08956a4cb3f1e3d8e6b Author: Mikael Morin <[email protected]> Date: Tue Oct 20 14:46:44 2026 +0200 fortran: Fix copy from polymorphic pointer source in ALLOCATE [PR128033] TODO -- >8 -- For pointer arrays as allocate source argument, drop the forced temporary, and fix the retrieval of the array reference from the ALLOCATE source. To fix PR114024, r14-9160 introduced an automatic wrapping of the allocate source expression in parentheses, 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 as parent subreference the class container, 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 the PR114024 fix that introduced the automatic wrapping. It doesn't fix 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 chain 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 can also be used with the source expression as inpute. In the latter case, there can be subreferences coming after the main array reference, so the assertion is expected to trigger, but we shouldn't be looking for the last reference element in the chain in the first place, 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 in it are factored to set the new pointer. PR fortran/114024 PR fortran/128033 gcc/fortran/ChangeLog: * 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. * trans-stmt.cc (gfc_trans_allocate): Remove automatic wrapping of array subreferences in a parenthesis expression. 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 abc606dc627f..54b69a6ff3df 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 2a87176ffa9f..2a53bdaf9fc3 100644 --- a/gcc/fortran/trans-stmt.cc +++ b/gcc/fortran/trans-stmt.cc @@ -6727,14 +6727,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
