re PR fortran/69654 (ICE in gfc_trans_structure_assign)

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

	PR fortran/69654
	* trans-expr.c (gfc_trans_structure_assign): Move assignment to
	'cm' after treatment of C pointer types and test that the type
	has been completely built before it. Add an assert that the
	backend_decl for each component exists.

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

	PR fortran/69654
	* gfortran.dg/derived_init_6.f90: New test.

From-SVN: r278287

4 files changed, 85 insertions, 1 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 64b6573..bc74e46 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2019-11-15  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/69654
+	* trans-expr.c (gfc_trans_structure_assign): Move assignment to
+	'cm' after treatment of C pointer types and test that the type
+	has been completely built before it. Add an assert that the
+	backend_decl for each component exists.
+
 2019-11-13  Tobias Burnus  <tobias@codesourcery.com>
 
 	* trans-expr.c (gfc_conv_procedure_call): Fold hidden
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 267536d..fe89c7b 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -8330,7 +8330,6 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init, bool coarray)
   gfc_se se;
 
   gfc_start_block (&block);
-  cm = expr->ts.u.derived->components;
 
   if (expr->ts.u.derived->from_intmod == INTMOD_ISO_C_BINDING
       && (expr->ts.u.derived->intmod_sym_id == ISOCBINDING_PTR
@@ -8348,6 +8347,17 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init, bool coarray)
       return gfc_finish_block (&block);
     }
 
+  /* Make sure that the derived type has been completely built.  */
+  if (!expr->ts.u.derived->backend_decl
+      || !TYPE_FIELDS (expr->ts.u.derived->backend_decl))
+    {
+      tmp = gfc_typenode_for_spec (&expr->ts);
+      gcc_assert (tmp);
+    }
+
+  cm = expr->ts.u.derived->components;
+
+
   if (coarray)
     gfc_init_se (&se, NULL);
 
@@ -8418,6 +8428,7 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init, bool coarray)
 	  gfc_add_expr_to_block (&block, tmp);
 	}
       field = cm->backend_decl;
+      gcc_assert(field);
       tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
 			     dest, field, NULL_TREE);
       if (!c->expr)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 11a446c..6b12383 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-11-15  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/69654
+	* gfortran.dg/derived_init_6.f90: New test.
+
 2019-11-15  Matthew Malcomson  <matthew.malcomson@arm.com>
 
 	* gcc.dg/rtl/aarch64/test-epilogue-set.c: New test.
diff --git a/gcc/testsuite/gfortran.dg/derived_init_6.f90 b/gcc/testsuite/gfortran.dg/derived_init_6.f90
new file mode 100644
index 0000000..9641a50
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_init_6.f90
@@ -0,0 +1,60 @@
+! { dg-do compile }
+!
+! Test the fix for PR69654 in which the derived type 'ty_foo2' was
+! not completely built in time for initialization thereby causing an ICE.
+!
+! Contributed by Hossein Talebi  <talebi.hossein@gmail.com>
+!
+ Module foo_pointers_class
+   implicit none
+    type :: ty_foo_pointers
+      integer :: scale=0
+      integer,pointer :: universe_ulogfile => NULL()
+      class(*),pointer :: foo => NULL()
+    end type ty_foo_pointers
+
+   type :: ty_part_ptrs
+      character(len=80),pointer :: part_name => NULL()
+      class(*),pointer     :: part_fem => NULL()
+   end type
+
+   type :: ty_class_basis
+      integer :: id=0
+    end type ty_class_basis
+
+   type :: ty_store_sclass
+      class(ty_class_basis),allocatable :: OBJ
+   end type ty_store_sclass
+End Module foo_pointers_class
+
+Module foo_class
+   use foo_pointers_class
+   implicit none
+   type,extends(ty_class_basis) :: ty_foo2
+      character(200)                     :: title
+      logical                            :: isInit=.false.
+      type(ty_foo_pointers)              :: foo
+   end type ty_foo2
+ENd Module foo_class
+
+
+Module foo_scripts_mod
+  implicit none
+contains
+
+subroutine  foo_script1
+   use foo_class, only: ty_foo2
+   implicit none
+   type(ty_foo2) :: foo2
+   integer i
+
+   Call foo_init2(foo2)
+end subroutine  foo_script1
+
+subroutine foo_init2(self)
+   use foo_class, only: ty_foo2
+   type(ty_foo2),target :: self
+   self%isInit=.true.
+end subroutine foo_init2
+
+End Module foo_scripts_mod