[Patch, fortran] PR124780 - Bugs found while testing the fix for PR100155
Paul Richard Thomas <[email protected]>
| Newsgroups | gmane.comp.gcc.patches,gmane.comp.gcc.fortran |
|---|---|
| Message-ID | <CAGkQGi+br6fOv7c61W7N7ijnpxHFbMoC1BPZboW3R62wfAYqxQ@mail.gmail.com> |
Hello Harald, Thanks for the review of the patch for PR100155. The attached fixes the bugs that you found while testing the fix. Regtests with FC43/x86_64 - OK for mainline and later backporting with the patch for PR1000155? Best regards Paul On Fri, 3 Apr 2026 at 22:09, Harald Anlauf <[email protected]> wrote: > > Hi Paul, > > I see that you are either not a fan of worms or just vegan... > > Well, this looks like a not so easy thing to fix. > Your (partial) patch at least improves the situation. > Unless someone else objects, proceed on mainline, > and wait a while before considering backporting. > Also update the PR accordingly. > > Thanks, > Harald
submit2.diff
(text/x-patch, 4.9 KB)
From 4afa13cf53400dd1dfea6d5453748ce29f322de3 Mon Sep 17 00:00:00 2001 From: Paul Thomas <[email protected]> Date: Sun, 5 Apr 2026 10:53:08 +0100 Subject: [PATCH] Fortran: Bugs found while testing r16-8436 [PR124780] 2026-04-05 Paul Thomas <[email protected]> gcc/fortran PR fortran/124780 * resolve.cc (resolve_ordinary_assign): Do not add the class data component to an operator expression. * trans-expr.cc (gfc_trans_scalar_assign): If class to class assignment uses ordinary scalar assignment and neither lhs or rhs are class types, do a deep copy for allocatable components. gcc/testsuite/ PR fortran/124780 * gfortran.dg/pr124780.f90: New test. --- gcc/fortran/resolve.cc | 3 ++- gcc/fortran/trans-expr.cc | 27 ++++++++++++++++--- gcc/testsuite/gfortran.dg/pr124780.f90 | 36 ++++++++++++++++++++++++++ 3 files changed, 61 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr124780.f90 diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 767bbdea114..638c36595d9 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -13219,7 +13219,8 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns) /* Assign the 'data' of a class object to a derived type. */ if (lhs->ts.type == BT_DERIVED && rhs->ts.type == BT_CLASS - && rhs->expr_type != EXPR_ARRAY) + && (rhs->expr_type != EXPR_ARRAY + && rhs->expr_type != EXPR_OP)) gfc_add_data_component (rhs); /* Make sure there is a vtable and, in particular, a _copy for the diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index d6c580f8413..418d364fb36 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -11774,6 +11774,7 @@ gfc_trans_scalar_assign (gfc_se *lse, gfc_se *rse, gfc_typespec ts, stmtblock_t block; tree tmp; tree cond; + int caf_mode; gfc_init_block (&block); @@ -11862,7 +11863,7 @@ gfc_trans_scalar_assign (gfc_se *lse, gfc_se *rse, gfc_typespec ts, same as the lhs. */ if (deep_copy) { - int caf_mode = in_coarray ? (GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY + caf_mode = in_coarray ? (GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY | GFC_STRUCTURE_CAF_MODE_IN_COARRAY) : 0; tmp = gfc_copy_alloc_comp (ts.u.derived, rse->expr, lse->expr, 0, caf_mode); @@ -11889,12 +11890,30 @@ gfc_trans_scalar_assign (gfc_se *lse, gfc_se *rse, gfc_typespec ts, if (!trans_scalar_class_assign (&block, lse, rse)) { - /* ...otherwise assignment suffices. Note the use of VIEW_CONVERT_EXPR - for the lhs which ensures that class data rhs cast as a string assigns - correctly. */ + /* ..otherwise assignment suffices. Note the use of VIEW_CONVERT_EXPR + for the lhs which ensures that class data rhs cast as a string + assigns correctly. */ tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR, TREE_TYPE (rse->expr), lse->expr); gfc_add_modify (&block, tmp, rse->expr); + + /* Copy allocatable components but guard against class pointer + assign, which arrives here. */ +#define DATA_DT ts.u.derived->components->ts.u.derived + if (deep_copy + && !(GFC_CLASS_TYPE_P (TREE_TYPE (lse->expr)) + && GFC_CLASS_TYPE_P (TREE_TYPE (rse->expr))) + && ts.u.derived->components + && DATA_DT && DATA_DT->attr.alloc_comp) + { + caf_mode = in_coarray ? (GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY + | GFC_STRUCTURE_CAF_MODE_IN_COARRAY) + : 0; + tmp = gfc_copy_alloc_comp (DATA_DT, rse->expr, lse->expr, 0, + caf_mode); + gfc_add_expr_to_block (&block, tmp); + } +#undef DATA_DT } } else if (ts.type != BT_CLASS) diff --git a/gcc/testsuite/gfortran.dg/pr124780.f90 b/gcc/testsuite/gfortran.dg/pr124780.f90 new file mode 100644 index 00000000000..79245948a54 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr124780.f90 @@ -0,0 +1,36 @@ +! { dg-do run } +! +! Test the fix for PR124780, which failes as in comments below. +! +! Contributed by Harald Anlauf <[email protected]> +! +program p + integer :: i + type :: t + integer, allocatable :: i(:) + end type + type (t), allocatable :: src(:), ans(:) + src = [t([1,2]), t([3,4])] ! Leaks memory 16 bytes in 2 blocks; + ! familiar from PDT memory leaks :-( + ans = f(src) + do i = 1,2 + if (any (src(i)%i /= ans(i)%i)) stop 1 + deallocate (ans(i)%i, src(i)%i) + enddo + deallocate (ans, src) +contains + function f(x) result(z) + class(t), intent(inout) :: x(:) + type(t) :: z (size(x)) + class(t), allocatable :: a(:) + class(t), allocatable :: b(:) + allocate (a(size(x))) + select type (x) + type is (t) + a = x ! Mangled src and caused + ! double free at line 12 + end select + b = x + z = (b) ! ICE, without patch + end +end -- 2.53.0