[Patch, fortran] PR113363 - ICE on ASSOCIATE and unlimited polymorphic function

[Patch, fortran] PR113363 - ICE on ASSOCIATE and unlimited polymorphic function

[Paul Richard Thomas]

[-- Attachment #1.1: Type: text/plain, Size: 1149 bytes --]

Hi All,

This patch corrects incorrect results from assignment of unlimited
polymorphic function results both in assignment statements and allocation
with source.

The first chunk in trans-array.cc ensures that the array dtype is set to
the source dtype. The second chunk ensures that the lhs _len field does not
default to zero and so is specific to dynamic types of character.

The addition to trans-stmt.cc transforms the source expression, aka expr3,
from a derived type of type "STAR" into a proper unlimited polymorphic
expression ready for assignment to the newly allocated entity.

OK for mainline?

Paul

Fortran: Fix wrong code in unlimited polymorphic assignment [PR113363]

2024-04-10  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
PR fortran/113363
* trans-array.cc (gfc_array_init_size): Use the expr3 dtype so
that the correct element size is used.
(gfc_alloc_allocatable_for_assignment): Set the _len field for
unlimited polymorphic assignments.
* trans-stmt.cc (gfc_trans_allocate): Build a correct rhs for
the assignment of an unlimited polymorphic 'source'.

gcc/testsuite/
PR fortran/113363
* gfortran.dg/pr113363.f90: New test.

[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 5706 bytes --]

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 30b84762346..2f9a32dda15 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -5957,6 +5957,11 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
       tmp = gfc_conv_descriptor_dtype (descriptor);
       gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type));
     }
+  else if (expr3_desc && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (expr3_desc)))
+    {
+      tmp = gfc_conv_descriptor_dtype (descriptor);
+      gfc_add_modify (pblock, tmp, gfc_conv_descriptor_dtype (expr3_desc));
+    }
   else
     {
       tmp = gfc_conv_descriptor_dtype (descriptor);
@@ -11324,6 +11329,9 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
 	    gfc_add_modify (&fblock, tmp,
 			    fold_convert (TREE_TYPE (tmp),
 					  TYPE_SIZE_UNIT (type)));
+	  else if (UNLIMITED_POLY (expr2))
+	    gfc_add_modify (&fblock, tmp,
+			    gfc_class_len_get (TREE_OPERAND (desc, 0)));
 	  else
 	    gfc_add_modify (&fblock, tmp,
 			    build_int_cst (TREE_TYPE (tmp), 0));
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 7997c167bae..c6953033cf4 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -7187,6 +7187,45 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
 	  gfc_expr *rhs = e3rhs ? e3rhs : gfc_copy_expr (code->expr3);
 	  flag_realloc_lhs = 0;
 
+	  /* The handling of code->expr3 above produces a derived type of
+	     type "STAR", whose size defaults to size(void*). In order to
+	     have the right type information for the assignment, we must
+	     reconstruct an unlimited polymorphic rhs.  */
+	  if (UNLIMITED_POLY (code->expr3)
+	      && e3rhs && e3rhs->ts.type == BT_DERIVED
+	      && !strcmp (e3rhs->ts.u.derived->name, "STAR"))
+	    {
+	      gfc_ref *ref;
+	      gcc_assert (TREE_CODE (expr3_vptr) == COMPONENT_REF);
+	      tmp = gfc_create_var (gfc_typenode_for_spec (&code->expr3->ts),
+				    "e3");
+	      gfc_add_modify (&block, tmp,
+			      gfc_get_class_from_expr (expr3_vptr));
+	      rhs->symtree->n.sym->backend_decl = tmp;
+	      rhs->ts = code->expr3->ts;
+	      rhs->symtree->n.sym->ts = rhs->ts;
+	      for (ref = init_expr->ref; ref; ref = ref->next)
+		{
+		  /* Copy over the lhs _data component ref followed by the
+		     full array reference for source expressions with rank.
+		     Otherwise, just copy the _data component ref.  */
+		  if (code->expr3->rank
+		      && ref && ref->next && !ref->next->next)
+		    {
+		      rhs->ref = gfc_copy_ref (ref);
+		      rhs->ref->next = gfc_copy_ref (ref->next);
+		      break;
+		    }
+		  else if ((init_expr->rank && !code->expr3->rank
+			    && ref && ref->next && !ref->next->next)
+			   || (ref && !ref->next))
+		    {
+		      rhs->ref = gfc_copy_ref (ref);
+		      break;
+		    }
+		}
+	    }
+
 	  /* Set the symbol to be artificial so that the result is not finalized.  */
 	  init_expr->symtree->n.sym->attr.artificial = 1;
 	  tmp = gfc_trans_assignment (init_expr, rhs, true, false, true,
diff --git a/gcc/testsuite/gfortran.dg/pr113363.f90 b/gcc/testsuite/gfortran.dg/pr113363.f90
new file mode 100644
index 00000000000..7701539fdff
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr113363.f90
@@ -0,0 +1,86 @@
+! { dg-do run }
+! Test the fix for comment 1 in PR113363, which failed as in comments below.
+! Contributed by Harald Anlauf  <anlauf@gcc.gnu.org>
+program p
+  implicit none
+  class(*), allocatable :: x(:), y
+  character(*), parameter :: arr(2) = ["hello ","bye   "], &
+                             sca = "Have a nice day"
+
+! Bug was detected in polymorphic array function results
+  allocate(x, source = foo ())
+  call check1 (x, arr)              ! Wrong output "6 hello e"
+  deallocate (x)
+  x = foo ()
+  call check1 (x, arr)              ! Wrong output "0  "
+  associate (var => foo ())         ! OK after r14-9489-g3fd46d859cda10
+    call check1 (var, arr)          ! Now OK - outputs: "6 hello bye   "
+  end associate
+
+! Check scalar function results     ! All OK
+  allocate (y, source = bar())
+  call check2 (y, sca)
+  deallocate (y)
+  y = bar ()
+  call check2 (y, sca)
+  deallocate (y)
+  associate (var => bar ())
+    call check2 (var, sca)
+  end associate
+
+! Finally variable expressions...
+  allocate (y, source = x(1))       ! Gave zero length here
+  call check2 (y, "hello")
+  y = x(2)                          ! Segfaulted here
+  call check2 (y, "bye   ")
+  associate (var => x(2))           ! Gave zero length here
+    call check2 (var, "bye   ")
+  end associate
+
+! ...and constant expressions       ! All OK
+  deallocate(y)
+  allocate (y, source = "abcde")
+  call check2 (y, "abcde")
+  y = "hijklmnopq"
+  call check2 (y, "hijklmnopq")
+  associate (var => "mnopq")
+    call check2 (var, "mnopq")
+  end associate
+  deallocate (x, y)
+
+contains
+
+  function foo() result(res)
+    class(*), allocatable :: res(:)
+    res = arr
+  end function foo
+
+  function bar() result(res)
+    class(*), allocatable :: res
+    res = sca
+  end function bar
+
+  subroutine check1 (x, carg)
+    class(*), intent(in) :: x(:)
+    character(*) :: carg(:)
+    select type (x)
+    type is (character(*))
+!       print *, len(x), x
+      if (any (x .ne. carg)) stop 1
+    class default
+       stop 2
+    end select
+  end subroutine check1
+
+  subroutine check2 (x, carg)
+    class(*), intent(in) :: x
+    character(*) :: carg
+    select type (x)
+    type is (character(*))
+!       print *, len(x), x
+      if (x .ne. carg) stop 3
+    class default
+       stop 4
+    end select
+  end subroutine check2
+end

Re: [Patch, fortran] PR113363 - ICE on ASSOCIATE and unlimited polymorphic function

[Harald Anlauf]

Hi Paul!

On 4/10/24 10:25, Paul Richard Thomas wrote:
> Hi All,
>
> This patch corrects incorrect results from assignment of unlimited
> polymorphic function results both in assignment statements and allocation
> with source.
>
> The first chunk in trans-array.cc ensures that the array dtype is set to
> the source dtype. The second chunk ensures that the lhs _len field does not
> default to zero and so is specific to dynamic types of character.
>
> The addition to trans-stmt.cc transforms the source expression, aka expr3,
> from a derived type of type "STAR" into a proper unlimited polymorphic
> expression ready for assignment to the newly allocated entity.

I am wondering about the following snippet in trans-stmt.cc:

+		  /* Copy over the lhs _data component ref followed by the
+		     full array reference for source expressions with rank.
+		     Otherwise, just copy the _data component ref.  */
+		  if (code->expr3->rank
+		      && ref && ref->next && !ref->next->next)
+		    {
+		      rhs->ref = gfc_copy_ref (ref);
+		      rhs->ref->next = gfc_copy_ref (ref->next);
+		      break;
+		    }

Why the two gfc_copy_ref?  valgrind pointed my to the tail
of gfc_copy_ref which already has:

   dest->next = gfc_copy_ref (src->next);

so this looks redundant and leaks frontend memory?

***

Playing with the testcase, I find several invalid writes with
valgrind, or a heap buffer overflow with -fsanitize=address .

It is sufficient to look at a mini-test where the class(*) function
result is assigned to the class(*), allocatable in the main:

   x = foo ()
   deallocate (x)

The dump tree suggests that array bounds in foo() are read before
they are properly set.

These invalid writes do not occur with 13-branch, so this might
be a regression.

Can you have a look yourself?

Thanks,
Harald

> OK for mainline?
>
> Paul
>
> Fortran: Fix wrong code in unlimited polymorphic assignment [PR113363]
>
> 2024-04-10  Paul Thomas  <pault@gcc.gnu.org>
>
> gcc/fortran
> PR fortran/113363
> * trans-array.cc (gfc_array_init_size): Use the expr3 dtype so
> that the correct element size is used.
> (gfc_alloc_allocatable_for_assignment): Set the _len field for
> unlimited polymorphic assignments.
> * trans-stmt.cc (gfc_trans_allocate): Build a correct rhs for
> the assignment of an unlimited polymorphic 'source'.
>
> gcc/testsuite/
> PR fortran/113363
> * gfortran.dg/pr113363.f90: New test.
>

Re: [Patch, fortran] PR113363 - ICE on ASSOCIATE and unlimited polymorphic function

[Paul Richard Thomas]

[-- Attachment #1.1: Type: text/plain, Size: 2057 bytes --]

Hi Harald,

Please find attached my resubmission for pr113363. The changes are as
follows:
(i) The chunk in gfc_conv_procedure_call is new. This was the source of one
of the memory leaks;
(ii) The incorporation of the _len field in trans_class_assignment was done
for the pr84006 patch;
(iii) The source of all the invalid memory accesses and so on was down to
the use of realloc. I tried all sorts of workarounds such as testing the
vptrs and the sizes but only free followed by malloc worked. I have no idea
at all why this is the case; and
(iv) I took account of your remarks about the chunk in trans-array.cc by
removing it and that the chunk in trans-stmt.cc would leak frontend memory.

OK for mainline (and -14 branch after a few-weeks)?

Regards

Paul

Fortran: Fix wrong code in unlimited polymorphic assignment [PR113363]

2024-05-12  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
PR fortran/113363
* trans-array.cc (gfc_array_init_size): Use the expr3 dtype so
that the correct element size is used.
* trans-expr.cc (gfc_conv_procedure_call): Remove restriction
that ss and ss->loop be present for the finalization of class
array function results.
(trans_class_assignment): Use free and malloc, rather than
realloc, for character expressions assigned to unlimited poly
entities.
* trans-stmt.cc (gfc_trans_allocate): Build a correct rhs for
the assignment of an unlimited polymorphic 'source'.

gcc/testsuite/
PR fortran/113363
* gfortran.dg/pr113363.f90: New test.


> > The first chunk in trans-array.cc ensures that the array dtype is set to
> > the source dtype. The second chunk ensures that the lhs _len field does
> not
> > default to zero and so is specific to dynamic types of character.
> >
>
> Why the two gfc_copy_ref?  valgrind pointed my to the tail
> of gfc_copy_ref which already has:
>
>    dest->next = gfc_copy_ref (src->next);
>
> so this looks redundant and leaks frontend memory?
>
> ***
>
> Playing with the testcase, I find several invalid writes with
> valgrind, or a heap buffer overflow with -fsanitize=address .
>
>
>

[-- Attachment #2: resubmit.diff --]
[-- Type: text/x-patch, Size: 7637 bytes --]

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 7ec33fb1598..c5b56f4e273 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -5957,6 +5957,11 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
       tmp = gfc_conv_descriptor_dtype (descriptor);
       gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type));
     }
+  else if (expr3_desc && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (expr3_desc)))
+    {
+      tmp = gfc_conv_descriptor_dtype (descriptor);
+      gfc_add_modify (pblock, tmp, gfc_conv_descriptor_dtype (expr3_desc));
+    }
   else
     {
       tmp = gfc_conv_descriptor_dtype (descriptor);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 4590aa6edb4..e315e2d3370 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -8245,8 +8245,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	 call the finalization function of the temporary. Note that the
 	 nullification of allocatable components needed by the result
 	 is done in gfc_trans_assignment_1.  */
-      if (expr && ((gfc_is_class_array_function (expr)
-		    && se->ss && se->ss->loop)
+      if (expr && (gfc_is_class_array_function (expr)
 		   || gfc_is_alloc_class_scalar_function (expr))
 	  && se->expr && GFC_CLASS_TYPE_P (TREE_TYPE (se->expr))
 	  && expr->must_finalize)
@@ -12028,18 +12027,25 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs,
 
       /* Reallocate if dynamic types are different. */
       gfc_init_block (&re_alloc);
-      tmp = fold_convert (pvoid_type_node, class_han);
-      re = build_call_expr_loc (input_location,
-				builtin_decl_explicit (BUILT_IN_REALLOC), 2,
-				tmp, size);
-      re = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (tmp), tmp,
-			    re);
-      tmp = fold_build2_loc (input_location, NE_EXPR,
-			     logical_type_node, rhs_vptr, old_vptr);
-      re = fold_build3_loc (input_location, COND_EXPR, void_type_node,
-			    tmp, re, build_empty_stmt (input_location));
-      gfc_add_expr_to_block (&re_alloc, re);
-
+      if (UNLIMITED_POLY (lhs) && rhs->ts.type == BT_CHARACTER)
+	{
+	  gfc_add_expr_to_block (&re_alloc, gfc_call_free (class_han));
+	  gfc_allocate_using_malloc (&re_alloc, class_han, size, NULL_TREE);
+	}
+      else
+	{
+	  tmp = fold_convert (pvoid_type_node, class_han);
+	  re = build_call_expr_loc (input_location,
+				    builtin_decl_explicit (BUILT_IN_REALLOC),
+				    2, tmp, size);
+	  re = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (tmp),
+				tmp, re);
+	  tmp = fold_build2_loc (input_location, NE_EXPR,
+				 logical_type_node, rhs_vptr, old_vptr);
+	  re = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+				tmp, re, build_empty_stmt (input_location));
+	  gfc_add_expr_to_block (&re_alloc, re);
+	}
       tree realloc_expr = lhs->ts.type == BT_CLASS ?
 					  gfc_finish_block (&re_alloc) :
 					  build_empty_stmt (input_location);
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index d355009fa5e..9b497d6bdc6 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -7215,6 +7215,46 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
 	  gfc_expr *rhs = e3rhs ? e3rhs : gfc_copy_expr (code->expr3);
 	  flag_realloc_lhs = 0;
 
+	  /* The handling of code->expr3 above produces a derived type of
+	     type "STAR", whose size defaults to size(void*). In order to
+	     have the right type information for the assignment, we must
+	     reconstruct an unlimited polymorphic rhs.  */
+	  if (UNLIMITED_POLY (code->expr3)
+	      && e3rhs && e3rhs->ts.type == BT_DERIVED
+	      && !strcmp (e3rhs->ts.u.derived->name, "STAR"))
+	    {
+	      gfc_ref *ref;
+	      gcc_assert (TREE_CODE (expr3_vptr) == COMPONENT_REF);
+	      tmp = gfc_create_var (gfc_typenode_for_spec (&code->expr3->ts),
+				    "e3");
+	      gfc_add_modify (&block, tmp,
+			      gfc_get_class_from_expr (expr3_vptr));
+	      rhs->symtree->n.sym->backend_decl = tmp;
+	      rhs->ts = code->expr3->ts;
+	      rhs->symtree->n.sym->ts = rhs->ts;
+	      for (ref = init_expr->ref; ref; ref = ref->next)
+		{
+		  /* Copy over the lhs _data component ref followed by the
+		     full array reference for source expressions with rank.
+		     Otherwise, just copy the _data component ref.  */
+		  if (code->expr3->rank
+		      && ref && ref->next && !ref->next->next)
+		    {
+		      rhs->ref = gfc_copy_ref (ref);
+		      break;
+		    }
+		  else if ((init_expr->rank && !code->expr3->rank
+			    && ref && ref->next && !ref->next->next)
+			   || (ref && !ref->next))
+		    {
+		      rhs->ref = gfc_copy_ref (ref);
+		      gfc_free_ref_list (rhs->ref->next);
+		      rhs->ref->next = NULL;
+		      break;
+		    }
+		}
+	    }
+
 	  /* Set the symbol to be artificial so that the result is not finalized.  */
 	  init_expr->symtree->n.sym->attr.artificial = 1;
 	  tmp = gfc_trans_assignment (init_expr, rhs, true, false, true,
diff --git a/gcc/testsuite/gfortran.dg/pr113363.f90 b/gcc/testsuite/gfortran.dg/pr113363.f90
new file mode 100644
index 00000000000..99d4f2076d8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr113363.f90
@@ -0,0 +1,86 @@
+! { dg-do run }
+! Test the fix for comment 1 in PR113363, which failed as in comments below.
+! Contributed by Harald Anlauf  <anlauf@gcc.gnu.org>
+program p
+  implicit none
+  class(*), allocatable :: x(:), y
+  character(*), parameter :: arr(2) = ["hello ","bye   "], &
+                             sca = "Have a nice day"
+  character(10) :: const
+
+! Bug was detected in polymorphic array function results
+  allocate(x, source = foo ())
+  call check1 (x, arr)              ! Wrong output "6 hello e"
+  deallocate (x)
+  x = foo ()
+  call check1 (x, arr)              ! Wrong output "0  "
+  associate (var => foo ())         ! OK after r14-9489-g3fd46d859cda10
+    call check1 (var, arr)          ! Now OK - outputs: "6 hello bye   "
+  end associate
+
+! Check scalar function results     ! All OK
+  allocate (y, source = bar())
+  call check2 (y, sca)
+  deallocate (y)
+  y = bar ()
+  call check2 (y, sca)
+  deallocate (y)
+  associate (var => bar ())
+    call check2 (var, sca)
+  end associate
+
+! Finally variable expressions...
+  allocate (y, source = x(1))       ! Gave zero length here
+  call check2 (y, "hello")
+  y = x(2)                          ! Segfaulted here
+  call check2 (y, "bye   ")
+  associate (var => x(2))           ! Gave zero length here
+    call check2 (var, "bye   ")
+  end associate
+
+! ...and constant expressions       ! All OK
+  deallocate(y)
+  allocate (y, source = "abcde")
+  call check2 (y, "abcde")
+  const = "hijklmnopq"
+  y = const
+  call check2 (y, "hijklmnopq")
+  associate (var => "mnopq")
+    call check2 (var, "mnopq")
+  end associate
+  deallocate (x, y)
+
+contains
+
+  function foo() result(res)
+    class(*), allocatable :: res(:)
+    res = arr
+  end function foo
+
+  function bar() result(res)
+    class(*), allocatable :: res
+    res = sca
+  end function bar
+
+  subroutine check1 (x, carg)
+    class(*), intent(in) :: x(:)
+    character(*) :: carg(:)
+    select type (x)
+    type is (character(*))
+      if (any (x .ne. carg)) stop 1
+    class default
+       stop 2
+    end select
+  end subroutine check1
+
+  subroutine check2 (x, carg)
+    class(*), intent(in) :: x
+    character(*) :: carg
+    select type (x)
+    type is (character(*))
+      if (x .ne. carg) stop 3
+    class default
+       stop 4
+    end select
+  end subroutine check2
+end

Re: [Patch, fortran] PR113363 - ICE on ASSOCIATE and unlimited polymorphic function

[Harald Anlauf]

Hi Paul,

this looks all good now, and is OK for mainline as well as backporting!

***

While playing with the testcase, I found 3 remaining smaller issues that
are pre-existing, so they should not delay your present work.  To make
it clear: these are not regressions.

When "maliciously" perturbing the testcase by adding parentheses in the
right places, I see the following:

Replacing

   associate (var => foo ())         ! OK after r14-9489-g3fd46d859cda10

by

   associate (var => (foo ()))

gives an ICE here with 14-branch and 15-mainline.

Similarly replacing

   allocate (y, source = x(1))       ! Gave zero length here

by

   allocate (y, source = (x(1)))

Furthermore, replacing

   allocate(x, source = foo ())
by

   allocate(x, source = (foo ()))

gives a runtime segfault with both 14-branch and 15-mainline.
So this is something for another day...

Thanks for the patch!

Harald


Am 12.05.24 um 13:27 schrieb Paul Richard Thomas:
> Hi Harald,
>
> Please find attached my resubmission for pr113363. The changes are as
> follows:
> (i) The chunk in gfc_conv_procedure_call is new. This was the source of one
> of the memory leaks;
> (ii) The incorporation of the _len field in trans_class_assignment was done
> for the pr84006 patch;
> (iii) The source of all the invalid memory accesses and so on was down to
> the use of realloc. I tried all sorts of workarounds such as testing the
> vptrs and the sizes but only free followed by malloc worked. I have no idea
> at all why this is the case; and
> (iv) I took account of your remarks about the chunk in trans-array.cc by
> removing it and that the chunk in trans-stmt.cc would leak frontend memory.
>
> OK for mainline (and -14 branch after a few-weeks)?
>
> Regards
>
> Paul
>
> Fortran: Fix wrong code in unlimited polymorphic assignment [PR113363]
>
> 2024-05-12  Paul Thomas  <pault@gcc.gnu.org>
>
> gcc/fortran
> PR fortran/113363
> * trans-array.cc (gfc_array_init_size): Use the expr3 dtype so
> that the correct element size is used.
> * trans-expr.cc (gfc_conv_procedure_call): Remove restriction
> that ss and ss->loop be present for the finalization of class
> array function results.
> (trans_class_assignment): Use free and malloc, rather than
> realloc, for character expressions assigned to unlimited poly
> entities.
> * trans-stmt.cc (gfc_trans_allocate): Build a correct rhs for
> the assignment of an unlimited polymorphic 'source'.
>
> gcc/testsuite/
> PR fortran/113363
> * gfortran.dg/pr113363.f90: New test.
>
>
>>> The first chunk in trans-array.cc ensures that the array dtype is set to
>>> the source dtype. The second chunk ensures that the lhs _len field does
>> not
>>> default to zero and so is specific to dynamic types of character.
>>>
>>
>> Why the two gfc_copy_ref?  valgrind pointed my to the tail
>> of gfc_copy_ref which already has:
>>
>>     dest->next = gfc_copy_ref (src->next);
>>
>> so this looks redundant and leaks frontend memory?
>>
>> ***
>>
>> Playing with the testcase, I find several invalid writes with
>> valgrind, or a heap buffer overflow with -fsanitize=address .
>>
>>
>>
>