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

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

	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  Paul Thomas  <pault@gcc.gnu.org>

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

From-SVN: r268474

4 files changed, 60 insertions, 10 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6dba135..ce6df90 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,13 @@
 2019-02-02  Paul Thomas  <pault@gcc.gnu.org>
 
+	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  Paul Thomas  <pault@gcc.gnu.org>
+
 	PR fortran/88980
 	* trans-array.c (gfc_array_init_size): Add element_size to the
 	arguments.
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 1cbef7f..e7c7591 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6042,6 +6042,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)
@@ -6053,16 +6063,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);
-	    }
-
 	  if (!finalized && !e->must_finalize)
 	    {
 	      if ((e->ts.type == BT_CLASS
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d94a3be..727dc4b 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 2019-02-02  Paul Thomas  <pault@gcc.gnu.org>
 
+	PR fortran/88393
+	* gfortran.dg/alloc_comp_assign_16.f03 : New test.
+
+2019-02-02  Paul Thomas  <pault@gcc.gnu.org>
+
 	PR fortran/88980
 	* gfortran.dg/realloc_on_assign_32.f90 : New test.
 
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
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