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
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

Reply via email to