From 245471c67f3ad27a85dce999933cec1ff298be02 Mon Sep 17 00:00:00 2001 From: Fritz Reese Date: Thu, 5 Jul 2018 15:39:27 +0000 Subject: [PATCH] re PR fortran/83183 (Out of memory with option -finit-derived) 2018-07-05 Fritz Reese gcc/fortran/ChangeLog: PR fortran/83183 PR fortran/86325 * expr.c (class_allocatable, class_pointer, comp_allocatable, comp_pointer): New helpers. (component_initializer): Generate EXPR_NULL for allocatable or pointer components. Do not generate initializers for components within BT_CLASS. Do not assign to comp->initializer. (gfc_generate_initializer): Use new helpers; move code to generate EXPR_NULL for class allocatable components into component_initializer(). gcc/testsuite/ChangeLog: PR fortran/83183 PR fortran/86325 * gfortran.dg/init_flag_18.f90: New testcase. * gfortran.dg/init_flag_19.f03: New testcase. From-SVN: r262442 --- gcc/fortran/ChangeLog | 12 ++++ gcc/fortran/expr.c | 73 ++++++++++++++-------- gcc/testsuite/ChangeLog | 7 +++ gcc/testsuite/gfortran.dg/init_flag_18.f90 | 19 ++++++ gcc/testsuite/gfortran.dg/init_flag_19.f03 | 36 +++++++++++ 5 files changed, 122 insertions(+), 25 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/init_flag_18.f90 create mode 100644 gcc/testsuite/gfortran.dg/init_flag_19.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b43c08358ce..f810379aea5 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2018-07-05 Fritz Reese + + PR fortran/83183 + PR fortran/86325 + * expr.c (class_allocatable, class_pointer, comp_allocatable, + comp_pointer): New helpers. + (component_initializer): Generate EXPR_NULL for allocatable or pointer + components. Do not generate initializers for components within BT_CLASS. + Do not assign to comp->initializer. + (gfc_generate_initializer): Use new helpers; move code to generate + EXPR_NULL for class allocatable components into component_initializer(). + 2018-07-04 Jerry DeLisle PR fortran/82009 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 951bdce98ac..c5bf822cd24 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -4452,25 +4452,60 @@ get_union_initializer (gfc_symbol *union_type, gfc_component **map_p) return init; } +static bool +class_allocatable (gfc_component *comp) +{ + return comp->ts.type == BT_CLASS && CLASS_DATA (comp) + && CLASS_DATA (comp)->attr.allocatable; +} + +static bool +class_pointer (gfc_component *comp) +{ + return comp->ts.type == BT_CLASS && CLASS_DATA (comp) + && CLASS_DATA (comp)->attr.pointer; +} + +static bool +comp_allocatable (gfc_component *comp) +{ + return comp->attr.allocatable || class_allocatable (comp); +} + +static bool +comp_pointer (gfc_component *comp) +{ + return comp->attr.pointer + || comp->attr.pointer + || comp->attr.proc_pointer + || comp->attr.class_pointer + || class_pointer (comp); +} + /* Fetch or generate an initializer for the given component. Only generate an initializer if generate is true. */ static gfc_expr * -component_initializer (gfc_typespec *ts, gfc_component *c, bool generate) +component_initializer (gfc_component *c, bool generate) { gfc_expr *init = NULL; - /* See if we can find the initializer immediately. - Some components should never get initializers. */ - if (c->initializer || !generate - || (ts->type == BT_CLASS && !c->attr.allocatable) - || c->attr.pointer - || c->attr.class_pointer - || c->attr.proc_pointer) + /* Allocatable components always get EXPR_NULL. + Pointer components are only initialized when generating, and only if they + do not already have an initializer. */ + if (comp_allocatable (c) || (generate && comp_pointer (c) && !c->initializer)) + { + init = gfc_get_null_expr (&c->loc); + init->ts = c->ts; + return init; + } + + /* See if we can find the initializer immediately. */ + if (c->initializer || !generate) return c->initializer; /* Recursively handle derived type components. */ - if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS) + else if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS) init = gfc_generate_initializer (&c->ts, true); else if (c->ts.type == BT_UNION && c->ts.u.derived->components) @@ -4518,7 +4553,7 @@ component_initializer (gfc_typespec *ts, gfc_component *c, bool generate) gfc_apply_init (&c->ts, &c->attr, init); } - return (c->initializer = init); + return init; } @@ -4579,9 +4614,7 @@ gfc_generate_initializer (gfc_typespec *ts, bool generate) if (!generate) { for (; comp; comp = comp->next) - if (comp->initializer || comp->attr.allocatable - || (comp->ts.type == BT_CLASS && CLASS_DATA (comp) - && CLASS_DATA (comp)->attr.allocatable)) + if (comp->initializer || comp_allocatable (comp)) break; } @@ -4597,7 +4630,7 @@ gfc_generate_initializer (gfc_typespec *ts, bool generate) gfc_constructor *ctor = gfc_constructor_get(); /* Fetch or generate an initializer for the component. */ - tmp = component_initializer (ts, comp, generate); + tmp = component_initializer (comp, generate); if (tmp) { /* Save the component ref for STRUCTUREs and UNIONs. */ @@ -4607,8 +4640,7 @@ gfc_generate_initializer (gfc_typespec *ts, bool generate) /* If the initializer was not generated, we need a copy. */ ctor->expr = comp->initializer ? gfc_copy_expr (tmp) : tmp; - if ((comp->ts.type != tmp->ts.type - || comp->ts.kind != tmp->ts.kind) + if ((comp->ts.type != tmp->ts.type || comp->ts.kind != tmp->ts.kind) && !comp->attr.pointer && !comp->attr.proc_pointer) { bool val; @@ -4618,15 +4650,6 @@ gfc_generate_initializer (gfc_typespec *ts, bool generate) } } - if (comp->attr.allocatable - || (comp->ts.type == BT_CLASS && CLASS_DATA (comp)->attr.allocatable)) - { - ctor->expr = gfc_get_expr (); - ctor->expr->expr_type = EXPR_NULL; - ctor->expr->where = init->where; - ctor->expr->ts = comp->ts; - } - gfc_constructor_append (&init->value.constructor, ctor); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 33ac7402534..a812b508241 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2018-07-05 Fritz Reese + + PR fortran/83183 + PR fortran/86325 + * gfortran.dg/init_flag_18.f90: New testcase. + * gfortran.dg/init_flag_19.f03: New testcase. + 2018-07-05 Carl Love * gcc.target/altivec-1-runnable.c: New test file. * gcc.target/altivec-2-runnable.c: New test file. diff --git a/gcc/testsuite/gfortran.dg/init_flag_18.f90 b/gcc/testsuite/gfortran.dg/init_flag_18.f90 new file mode 100644 index 00000000000..9ab00a9afce --- /dev/null +++ b/gcc/testsuite/gfortran.dg/init_flag_18.f90 @@ -0,0 +1,19 @@ +! { dg-do compile } +! { dg-options "-finit-derived" } +! +! PR fortran/83183 +! +! Test a regression where -finit-derived recursed infinitely generating +! initializers for allocatable components of the same derived type. +! + +program pr83183 + type :: linked_list + type(linked_list), allocatable :: link + integer :: value + end type + type(linked_list) :: test + allocate(test % link) + print *, test%value + print *, test%link%value +end program diff --git a/gcc/testsuite/gfortran.dg/init_flag_19.f03 b/gcc/testsuite/gfortran.dg/init_flag_19.f03 new file mode 100644 index 00000000000..bbcee8aa8b4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/init_flag_19.f03 @@ -0,0 +1,36 @@ +! { dg-do compile } +! { dg-options "-finit-derived -finit-local-zero -fdump-tree-original" } +! +! Test initializers for BT_CLASS components/variables with -finit-derived. +! + +implicit none + +type :: ty1 + integer :: ival + real :: rval +end type + +type :: ty2 + type(ty1) :: bt + type(ty1), allocatable :: bt_alloc + type(ty1), pointer :: bt_ptr + class(ty1), allocatable :: class_alloc + class(ty1), pointer :: class_ptr +end type + +type(ty2) basic +class(ty1), allocatable :: calloc + +print *, basic%bt%ival +print *, calloc%ival + +end + +! { dg-final { scan-tree-dump-times "\.ival *= *0" 1 "original" } } +! { dg-final { scan-tree-dump-times "\.rval *= *0" 1 "original" } } +! { dg-final { scan-tree-dump-times "\.bt_ptr *= *0" 1 "original" } } +! { dg-final { scan-tree-dump-times "\.bt_alloc *= *0" 1 "original" } } +! { dg-final { scan-tree-dump-times "\.class_alloc(?: *= *\{)?\._data *= *0" 1 "original" } } +! { dg-final { scan-tree-dump-times "\.class_ptr(?: *= *\{)?\._data *= *0" 1 "original" } } +! { dg-final { scan-tree-dump-times "calloc(?: *= *\{)?\._data *= *0" 1 "original" } } -- 2.30.2