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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6dba135459fac039d0dfc49726c282723f508952..ce6df90aa775c67b4af73617d523858ae3521fc8 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+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

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 1cbef7f4c292bf7415717cf5871665e79e093ba5..e7c75913bfe3382361adb0b01e4661cad3153715 100644 (file)
--- 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 d94a3be174641677a368f7cde9c24ca311f99f1c..727dc4bf43b3b728e6f69828649067b776a87a83 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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

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