backport: re PR fortran/78641 ([OOP] ICE on polymorphic allocatable function in array...

2017-11-06  Paul Thomas  <pault@gcc.gnu.org>

	Backported from trunk
	PR fortran/78641
	* resolve.c (resolve_ordinary_assign): Do not add the _data
	component for class valued array constructors being assigned
	to derived type arrays.
	* trans-array.c (gfc_trans_array_ctor_element): Take the _data
	of class valued elements for assignment to derived type arrays.

2017-11-06  Paul Thomas  <pault@gcc.gnu.org>

	Backported from trunk
	PR fortran/78641
	* gfortran.dg/class_66.f90: New test.

From-SVN: r254449

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index bc8c8bbf323ab383731f266e9462f56e7edbf037..d7f4609dc717c024a200e7aa1c9d9e0373ad2c00 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2017-11-06  Paul Thomas  <pault@gcc.gnu.org>
+
+       Backported from trunk
+       PR fortran/78641
+       * resolve.c (resolve_ordinary_assign): Do not add the _data
+       component for class valued array constructors being assigned
+       to derived type arrays.
+       * trans-array.c (gfc_trans_array_ctor_element): Take the _data
+       of class valued elements for assignment to derived type arrays.
+
 2017-11-06  Paul Thomas  <pault@gcc.gnu.org>
 
        Backported from trunk

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 41d1e6af44ffb2fce279a776c6ef427bde7a73c8..9b83779605abff570c556789a4ecadd9a1f02570 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9791,7 +9791,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->ts.type == BT_CLASS
+      && rhs->expr_type != EXPR_ARRAY)
     gfc_add_data_component (rhs);
 
   /* Insert a GFC_ISYM_CAF_SEND intrinsic, when the LHS is a coindexed variable.

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 0882a3a0e7ff6010ab8148d3f0c98e6942024c7a..b1a07f5defd2b731b019c2779b3f5cf268b51ff2 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1431,6 +1431,17 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
            }
        }
     }
+  else if (GFC_CLASS_TYPE_P (TREE_TYPE (se->expr))
+          && !GFC_CLASS_TYPE_P (gfc_get_element_type (TREE_TYPE (desc))))
+    {
+      /* Assignment of a CLASS array constructor to a derived type array.  */
+      if (expr->expr_type == EXPR_FUNCTION)
+       se->expr = gfc_evaluate_now (se->expr, pblock);
+      se->expr = gfc_class_data_get (se->expr);
+      se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
+      se->expr = fold_convert (TREE_TYPE (tmp), se->expr);
+      gfc_add_modify (&se->pre, tmp, se->expr);
+    }
   else
     {
       /* TODO: Should the frontend already have done this conversion?  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index baab709cee50ed2df559558eb208b3dcc458cd04..e41932554cda670d9bf2d6dcd774328b40d3412c 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2017-11-06  Paul Thomas  <pault@gcc.gnu.org>
+
+       Backported from trunk
+       PR fortran/78641
+       * gfortran.dg/class_66.f90: New test.
+
 2017-11-06  Paul Thomas  <pault@gcc.gnu.org>
 
        Backported from trunk

diff --git a/gcc/testsuite/gfortran.dg/class_66.f90 b/gcc/testsuite/gfortran.dg/class_66.f90
new file mode 100644 (file)
index 0000000..1843ea7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_66.f90
@@ -0,0 +1,28 @@
+! { dg- do run }
+!
+! Test the fix for PR78641 in which an ICE occured on assignment
+! of a class array constructor to a derived type array.
+!
+! Contributed by Damian Rouson  <damian@sourceryinstitute.org>
+!
+  implicit none
+  type foo
+    integer :: i = 99
+  end type
+  type(foo) :: bar(4)
+  class(foo), allocatable :: barfoo
+
+  allocate(barfoo,source = f(11))
+  bar = [f(33), [f(22), barfoo], f(1)]
+  if (any (bar%i .ne. [33, 22, 11, 1])) call abort
+  deallocate (barfoo)
+
+contains
+
+  function f(arg) result(foobar)
+    class(foo), allocatable :: foobar
+    integer :: arg
+    allocate(foobar,source = foo(arg))
+  end function
+
+end program