On Mon, Jun 25, 2018 at 9:04 PM Steve Kargl
<s...@troutmask.apl.washington.edu> wrote:
> ... It does seem odd to me
> that BT_CLASS has !c->attr.allocatable and BT_DERIVED
> is c->attr.allocatable, i.e., bang vs no bang. Is this
> because class is not affected by -finit-derived?
>
I'm glad you raised the question. As a result I looked a little harder
at the condition -- it had always been somewhat of a mystery to me
actually, as I copied it from some old initializer code. I'll talk
about what I discovered here. For a tl;dr see the bottom for a new
patch.
There are a few subtleties involved. First, 'ts->type' refers to the
type of the structure containing the component, rather than the
component itself. For this reason my patch is actually incorrect. The
new condition should read:
- || (ts->type == BT_DERIVED && c->attr.allocatable)
+ || (c->ts.type == BT_DERIVED && c->attr.allocatable)
The BT_CLASS clause is to prevent generating initializers for
components within a BT_CLASS definition, because these components are
special (_hash, _size, _extends, _def_init, _copy, _final,
_deallocate, _data, _vptr). I believe it is true that the
c->attr.allocatable check is bogus along with c->ts.type == BT_CLASS.
The intent is likely to pass-through component_initializer() for the
special "_data" component, so that EXPR_NULL will be used in
gfc_generate_initializer() for the condition around line 4580:
> if (comp->attr.allocatable
> || (comp->ts.type == BT_CLASS && CLASS_DATA (comp)->attr.allocatable))
> {
I've found I could exploit these weak conditions by using a BT_CLASS
pointer component with -finit-derived. I've reported the issue in PR
86325. After taking a good hard look at the conditions involved, I've
learned the following rules, which were previously unenforced:
* with -finit-derived, allocatable and pointer components (including
BT_CLASS components with an allocatable or pointer _data component)
should initialize with EXPR_NULL
* even without -finit-derived, allocatable components (including
BT_CLASS components with an allocatable _data component) should be
initialized using EXPR_NULL
* special components of a BT_CLASS structure (named _*) should never
have an initializer generated by gfc_generate_initializer()
* gfc_component::initializer is for user-defined assignment
initializers and should never be set by gfc_generate_initializer()
I have thus simplified, implemented, and documented the conditions and
rules above. Vacuously this fixes PR 83183, since a component which
would invoke a recursive derived-type initializer generation must be
allocatable or a pointer; with the above rules, such components are
now assigned EXPR_NULL with -finit-derived which avoids the recursion.
Without -finit-derived, allocatable components are still generated an
EXPR_NULL expression, matching the compiler's original behavior. This
also fixes PR 86325 (mentioned above).
The patch is attached. OK for trunk and 7/8-branch?
>From e190d59153eaa7fbfcfabc93db31ddda0de3b869 Mon Sep 17 00:00:00 2001
From: Fritz Reese <fritzore...@gmail.com>
Date: Mon, 25 Jun 2018 17:51:00 -0400
Subject: [PATCH 1/3] PR fortran/83183 PR fortran/86325
Fix allocatable/pointer conditions for -finit-derived.
gcc/fortran/
* 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/
* gfortran.dg/init_flag_19.f03: New testcase.
---
gcc/fortran/expr.c | 73 ++++++++++++++++++++----------
gcc/testsuite/gfortran.dg/init_flag_18.f90 | 19 ++++++++
gcc/testsuite/gfortran.dg/init_flag_19.f03 | 36 +++++++++++++++
3 files changed, 103 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
From e190d59153eaa7fbfcfabc93db31ddda0de3b869 Mon Sep 17 00:00:00 2001
From: Fritz Reese <fritzoreese@gmail.com>
Date: Mon, 25 Jun 2018 17:51:00 -0400
Subject: [PATCH 1/3] PR fortran/83183 PR fortran/86325
Fix allocatable/pointer conditions for -finit-derived.
gcc/fortran/
* 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/
* gfortran.dg/init_flag_19.f03: New testcase.
---
gcc/fortran/expr.c | 73 ++++++++++++++++++++----------
gcc/testsuite/gfortran.dg/init_flag_18.f90 | 19 ++++++++
gcc/testsuite/gfortran.dg/init_flag_19.f03 | 36 +++++++++++++++
3 files changed, 103 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/expr.c b/gcc/fortran/expr.c
index 5103a5cc990..6a7e09589a7 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4410,25 +4410,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)
@@ -4476,7 +4511,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;
}
@@ -4537,9 +4572,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;
}
@@ -4555,7 +4588,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. */
@@ -4565,8 +4598,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;
@@ -4576,15 +4608,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/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.12.2
