From 8eea62d8ab9c621b9d46926eb4c5380fe5606e4f Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Fri, 15 Nov 2019 12:42:29 +0000 Subject: [PATCH] re PR fortran/69654 (ICE in gfc_trans_structure_assign) 2019-11-15 Paul Thomas 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 PR fortran/69654 * gfortran.dg/derived_init_6.f90: New test. From-SVN: r278287 --- gcc/fortran/ChangeLog | 8 +++ gcc/fortran/trans-expr.c | 13 ++++- gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/derived_init_6.f90 | 60 ++++++++++++++++++++ 4 files changed, 85 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/derived_init_6.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 64b65730313..bc74e46ea8f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2019-11-15 Paul Thomas + + 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 * trans-expr.c (gfc_conv_procedure_call): Fold hidden diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 267536ddf2f..fe89c7b02ed 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 11a446cd9be..6b123832d5d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-11-15 Paul Thomas + + PR fortran/69654 + * gfortran.dg/derived_init_6.f90: New test. + 2019-11-15 Matthew Malcomson * 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 00000000000..9641a50f583 --- /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 +! + 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 -- 2.30.2