[fortran] PR124780 - Bugs found while testing the fix for PR100155

Message ID CAGkQGi+br6fOv7c61W7N7ijnpxHFbMoC1BPZboW3R62wfAYqxQ@mail.gmail.com
State New
Headers
Series [fortran] PR124780 - Bugs found while testing the fix for PR100155 |

Checks

Context Check Description
linaro-tcwg-bot/tcwg_gcc_build--master-aarch64 success Build passed
linaro-tcwg-bot/tcwg_gcc_check--master-aarch64 success Test passed
linaro-tcwg-bot/tcwg_gcc_build--master-arm success Build passed
linaro-tcwg-bot/tcwg_gcc_check--master-arm success Test passed

Commit Message

Paul Richard Thomas April 5, 2026, 10:03 a.m. UTC
  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 <anlauf@gmx.de> 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
  

Comments

Harald Anlauf April 5, 2026, 6:58 p.m. UTC | #1
Hi Paul,

Am 05.04.26 um 12:03 PM schrieb Paul Richard Thomas:
> 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?

this looks good to me and is fine for mainline and backporting.

Just a tiny nit in the testcase:

! Test the fix for PR124780, which failes as in comments below.

s/failes/fails/

unless this is your easter-egg.

Thanks for the patch!

Harald

> Best regards
> 
> Paul
> 
> On Fri, 3 Apr 2026 at 22:09, Harald Anlauf <anlauf@gmx.de> 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
  

Patch

From 4afa13cf53400dd1dfea6d5453748ce29f322de3 Mon Sep 17 00:00:00 2001
From: Paul Thomas <pault@gcc.gnu.org>
Date: Sun, 5 Apr 2026 10:53:08 +0100
Subject: [PATCH] Fortran: Bugs found while testing r16-8436 [PR124780]

2026-04-05  Paul Thomas  <pault@gcc.gnu.org>

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  <anlauf@gcc.gnu.org>
+!
+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