backport: re PR fortran/88393 ([OOP] Segfault with type-bound assignment)

2019-02-03  Paul Thomas  <pault@gcc.gnu.org>

	Backport from trunk
	PR fortran/88393
	* trans-expr.c (gfc_conv_procedure_call): For derived entities,
	passed in parentheses to class formals, invert the order of
	copying allocatable components to taking the _data of the
	class expression.

2019-02-03  Paul Thomas  <pault@gcc.gnu.org>

	Backport from trunk
	PR fortran/88393
	* gfortran.dg/alloc_comp_assign_16.f03 : New test.

From-SVN: r268501

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 704a15269dd7ce8844ce54a2f81a0c699e7f68f6..836dad5304b0f8970989136f13847ed59b02a682 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2019-02-03  Paul Thomas  <pault@gcc.gnu.org>
+
+       Backport from trunk
+       PR fortran/88393
+       * trans-expr.c (gfc_conv_procedure_call): For derived entities,
+       passed in parentheses to class formals, invert the order of
+       copying allocatable components to taking the _data of the
+       class expression.
+
 2019-02-02  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        PR fortran/88298

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 674eba9d9a6d5688cf84e9a06716924ed9b4156f..8b42bbccd455c9d7d5040b234c33fb98d656b5b1 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5712,6 +5712,16 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
              break;
            }
 
+         if (e->ts.type == BT_DERIVED && fsym && fsym->ts.type == BT_CLASS)
+           {
+             /* The derived type is passed to gfc_deallocate_alloc_comp.
+                Therefore, class actuals can be handled correctly but derived
+                types passed to class formals need the _data component.  */
+             tmp = gfc_class_data_get (tmp);
+             if (!CLASS_DATA (fsym)->attr.dimension)
+               tmp = build_fold_indirect_ref_loc (input_location, tmp);
+           }
+
          if (e->expr_type == EXPR_OP
                && e->value.op.op == INTRINSIC_PARENTHESES
                && e->value.op.op1->expr_type == EXPR_VARIABLE)
@@ -5723,16 +5733,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
              gfc_add_expr_to_block (&se->post, local_tmp);
            }
 
-         if (e->ts.type == BT_DERIVED && fsym && fsym->ts.type == BT_CLASS)
-           {
-             /* The derived type is passed to gfc_deallocate_alloc_comp.
-                Therefore, class actuals can handled correctly but derived
-                types passed to class formals need the _data component.  */
-             tmp = gfc_class_data_get (tmp);
-             if (!CLASS_DATA (fsym)->attr.dimension)
-               tmp = build_fold_indirect_ref_loc (input_location, tmp);
-           }
-
          tmp = gfc_deallocate_alloc_comp (e->ts.u.derived, tmp, parm_rank);
 
          gfc_prepend_expr_to_block (&post, tmp);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3499c0b3fd51154dffedebbba07d398b3efcf320..4f00558c0289a4803e67bbe3050c44c95e046ee7 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2019-02-03  Paul Thomas  <pault@gcc.gnu.org>
+
+       Backport from trunk
+       PR fortran/88393
+       * gfortran.dg/alloc_comp_assign_16.f03 : New test.
+
 2019-02-02  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        PR fortran/88298

diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_assign_16.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_assign_16.f03
new file mode 100644 (file)
index 0000000..892ea17
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_assign_16.f03
@@ -0,0 +1,37 @@
+! { dg-do run }
+!
+! Test the fix for PR88393 in which a segfault occurred as indicated.
+!
+! Contributed by Janus Weil  <janus@gcc.gnu.org>
+!
+module m
+   implicit none
+   type :: t
+      character(len=:), allocatable :: cs
+   contains
+      procedure :: ass
+      generic :: assignment(=) => ass
+   end type
+contains
+   subroutine ass(a, b)
+      class(t), intent(inout) :: a
+      class(t), intent(in)    :: b
+      a%cs = b%cs
+      print *, "ass"
+   end subroutine
+end module
+
+program p
+   use m
+   implicit none
+   type :: t2
+      type(t) :: c
+   end type
+   type(t2), dimension(1:2) :: arr
+   arr(1)%c%cs = "abcd"
+   arr(2)%c = arr(1)%c  ! Segfault here.
+   print *, "done", arr(2)%c%cs, arr(2)%c%cs
+! Make sure with valgrind that there are no memory leaks.
+   deallocate (arr(1)%c%cs)
+   deallocate (arr(2)%c%cs)
+end