The following attached patch regression tested on x86_64 and arm.
OK for mainline?
Regards,
Jerry
---
[PATCH] fortran: [PR128478] Copy a parenthesized scalar CLASS actual argument
A parenthesized scalar CLASS variable passed as an actual argument was
not copied, so the dummy aliased the variable, and passing it to a TYPE
dummy with allocatable components segfaulted, because the components of
the CLASS container were copied and freed as if it were the derived
type. Make the value of a parenthesized scalar CLASS variable a copy in
gfc_conv_expr_op, which also serves the ASSOCIATE selector, keep the
free of the copy until after the call, and leave its components to the
copy's own finalization.
Assisted-by: Claude Opus 5.5
PR fortran/128478
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_expr_op): Copy a parenthesized scalar
CLASS variable.
(gfc_conv_procedure_call): Do not copy or free the allocatable
components of the copy of a parenthesized scalar CLASS variable.
(gfc_conv_expr_reference): Keep the free of that copy in se->post.
* trans-stmt.cc (trans_associate_var): Remove the copy of a
parenthesized CLASS selector, now done by gfc_conv_expr_op.
gcc/testsuite/ChangeLog:
* gfortran.dg/asan/paren_class_copy_1.f90: New test.
---From 83a495cf752741c01879a8f49f5fcbe9cccf2d36 Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Fri, 6 Nov 2026 10:33:41 -0800
Subject: [PATCH] fortran: [PR128478] Copy a parenthesized scalar CLASS actual
argument
A parenthesized scalar CLASS variable passed as an actual argument was
not copied, so the dummy aliased the variable, and passing it to a TYPE
dummy with allocatable components segfaulted, because the components of
the CLASS container were copied and freed as if it were the derived
type. Make the value of a parenthesized scalar CLASS variable a copy in
gfc_conv_expr_op, which also serves the ASSOCIATE selector, keep the
free of the copy until after the call, and leave its components to the
copy's own finalization.
Assisted-by: Claude Opus 5.5
PR fortran/128478
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_expr_op): Copy a parenthesized scalar
CLASS variable.
(gfc_conv_procedure_call): Do not copy or free the allocatable
components of the copy of a parenthesized scalar CLASS variable.
(gfc_conv_expr_reference): Keep the free of that copy in se->post.
* trans-stmt.cc (trans_associate_var): Remove the copy of a
parenthesized CLASS selector, now done by gfc_conv_expr_op.
gcc/testsuite/ChangeLog:
* gfortran.dg/asan/paren_class_copy_1.f90: New test.
---
gcc/fortran/trans-expr.cc | 24 +++++++-
gcc/fortran/trans-stmt.cc | 8 ---
.../gfortran.dg/asan/paren_class_copy_1.f90 | 58 +++++++++++++++++++
3 files changed, 80 insertions(+), 10 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/asan/paren_class_copy_1.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index d41c3af108f..8e17ff60de2 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -4204,6 +4204,14 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
switch (expr->value.op.op)
{
case INTRINSIC_PARENTHESES:
+ /* The value of a parenthesized CLASS variable is a copy. */
+ if (expr->ts.type == BT_CLASS && expr->rank == 0
+ && parenthesized_variable (expr))
+ {
+ gfc_conv_expr (se, expr->value.op.op1);
+ gfc_conv_class_value_copy (se);
+ return;
+ }
if ((expr->ts.type == BT_REAL || expr->ts.type == BT_COMPLEX)
&& flag_protect_parens)
{
@@ -8927,12 +8935,14 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
procedures. As bounds information for descriptorless arrays is no
longer available here, they are dealt with in trans-array.cc
(gfc_conv_array_parameter). A derived-type temporary for a
- parenthesized variable shares the components of the variable. */
+ parenthesized variable shares the components of the variable, and
+ the copy of a parenthesized scalar CLASS variable frees its own. */
if (e && (e->ts.type == BT_DERIVED || e->ts.type == BT_CLASS)
&& e->ts.u.derived->attr.alloc_comp
&& (e->rank == 0 || elemental_proc || !nodesc_arg)
&& !expr_may_alias_variables (e, elemental_proc)
- && !(e->ts.type == BT_DERIVED && parenthesized_variable (e)))
+ && !((e->ts.type == BT_DERIVED || e->rank == 0)
+ && parenthesized_variable (e)))
{
int parm_rank;
/* It is known the e returns a structure type with at least one
@@ -11754,6 +11764,16 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr)
return;
}
+ /* The copy of a parenthesized CLASS variable is freed in se->post, so it
+ must stay there until after the copy's use. */
+ if (expr->ts.type == BT_CLASS && expr->rank == 0
+ && parenthesized_variable (expr))
+ {
+ gfc_conv_expr (se, expr);
+ se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
+ return;
+ }
+
if (expr->expr_type == EXPR_FUNCTION
&& ((expr->value.function.esym
&& expr->value.function.esym->result
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 0c080f59120..9083cd5edd2 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2376,14 +2376,6 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
gfc_add_block_to_block (&se.post, &se.finalblock);
need_len_assign = false;
}
- else if (sym->ts.type == BT_CLASS && e->expr_type == EXPR_OP
- && e->value.op.op == INTRINSIC_PARENTHESES && e->rank == 0)
- {
- /* A parenthesized selector is associated with a copy. */
- gfc_conv_expr (&se, e);
- gfc_conv_class_value_copy (&se);
- need_len_assign = false;
- }
else if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.dimension)
{
tree target_expr;
diff --git a/gcc/testsuite/gfortran.dg/asan/paren_class_copy_1.f90 b/gcc/testsuite/gfortran.dg/asan/paren_class_copy_1.f90
new file mode 100644
index 00000000000..5689691d808
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/asan/paren_class_copy_1.f90
@@ -0,0 +1,58 @@
+! { dg-do run }
+!
+! PR 128478
+! A parenthesized scalar CLASS variable passed as an actual argument is a
+! copy; without the fix the dummy aliased the variable, and a TYPE dummy
+! segfaulted. Checked under -fsanitize=address.
+
+module m
+ implicit none
+ type :: t
+ integer, allocatable :: v(:)
+ end type
+contains
+ subroutine sq (x, z)
+ class(*), intent(in) :: x
+ complex, intent(inout) :: z
+ z = (0., 0.)
+ select type (x)
+ type is (complex)
+ if (x /= (5., 6.)) stop 1
+ class default
+ stop 2
+ end select
+ end subroutine
+ subroutine st (x, z)
+ class(t), intent(in) :: x
+ type(t), intent(inout) :: z
+ z%v = [0, 0]
+ if (any (x%v /= [5, 6])) stop 3
+ end subroutine
+ subroutine s1 (x)
+ type(t), intent(in) :: x
+ if (any (x%v /= [5, 6])) stop 6
+ end subroutine
+end module
+
+program p
+ use m
+ implicit none
+ complex, target :: zs = (5., 6.)
+ type(t), target :: ts
+ class(*), pointer :: q
+ class(t), pointer :: qt
+ class(t), allocatable :: cs
+
+ q => zs
+ call sq ((q), zs)
+ if (zs /= (0., 0.)) stop 4
+
+ ts = t ([5, 6])
+ qt => ts
+ call st ((qt), ts)
+ if (any (ts%v /= 0)) stop 5
+
+ allocate (cs, source = t ([5, 6]))
+ call s1 ((cs))
+ if (any (cs%v /= [5, 6])) stop 7
+end program
--
2.56.0
