From 2e42c60f484e79f748d56de66379d504c7c24ac1 Mon Sep 17 00:00:00 2001 From: janus Date: Tue, 6 Aug 2013 08:20:17 +0000 Subject: [PATCH] 2013-08-06 Janus Weil PR fortran/57306 * class.c (gfc_class_null_initializer): Rename to 'gfc_class_initializer'. Treat non-NULL init-exprs. * gfortran.h (gfc_class_null_initializer): Update prototype. * trans-decl.c (gfc_get_symbol_decl): Treat class variables. * trans-expr.c (gfc_conv_initializer): Ditto. (gfc_trans_subcomponent_assign): Renamed gfc_class_null_initializer. 2013-08-06 Janus Weil PR fortran/57306 * gfortran.dg/pointer_init_8.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@201521 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 10 ++++++++++ gcc/fortran/class.c | 12 ++++++++---- gcc/fortran/gfortran.h | 2 +- gcc/fortran/trans-decl.c | 14 +++++++------- gcc/fortran/trans-expr.c | 14 +++++++++++--- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/pointer_init_8.f90 | 26 ++++++++++++++++++++++++++ 7 files changed, 68 insertions(+), 15 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pointer_init_8.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 8faf7ec01e7..7a9fe6ef8bd 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2013-08-06 Janus Weil + + PR fortran/57306 + * class.c (gfc_class_null_initializer): Rename to + 'gfc_class_initializer'. Treat non-NULL init-exprs. + * gfortran.h (gfc_class_null_initializer): Update prototype. + * trans-decl.c (gfc_get_symbol_decl): Treat class variables. + * trans-expr.c (gfc_conv_initializer): Ditto. + (gfc_trans_subcomponent_assign): Renamed gfc_class_null_initializer. + 2013-07-30 Tobias Burnus PR fortran/57530 diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 51bfd5685ea..fb16682e51c 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -412,12 +412,12 @@ gfc_is_class_container_ref (gfc_expr *e) } -/* Build a NULL initializer for CLASS pointers, - initializing the _data component to NULL and - the _vptr component to the declared type. */ +/* Build an initializer for CLASS pointers, + initializing the _data component to the init_expr (or NULL) and the _vptr + component to the corresponding type (or the declared type, given by ts). */ gfc_expr * -gfc_class_null_initializer (gfc_typespec *ts, gfc_expr *init_expr) +gfc_class_initializer (gfc_typespec *ts, gfc_expr *init_expr) { gfc_expr *init; gfc_component *comp; @@ -430,6 +430,8 @@ gfc_class_null_initializer (gfc_typespec *ts, gfc_expr *init_expr) if (is_unlimited_polymorphic && init_expr) vtab = gfc_find_intrinsic_vtab (&ts->u.derived->components->ts); + else if (init_expr && init_expr->expr_type != EXPR_NULL) + vtab = gfc_find_derived_vtab (init_expr->ts.u.derived); else vtab = gfc_find_derived_vtab (ts->u.derived); @@ -442,6 +444,8 @@ gfc_class_null_initializer (gfc_typespec *ts, gfc_expr *init_expr) gfc_constructor *ctor = gfc_constructor_get(); if (strcmp (comp->name, "_vptr") == 0 && vtab) ctor->expr = gfc_lval_expr_from_sym (vtab); + else if (init_expr && init_expr->expr_type != EXPR_NULL) + ctor->expr = gfc_copy_expr (init_expr); else ctor->expr = gfc_get_null_expr (NULL); gfc_constructor_append (&init->value.constructor, ctor); diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index c11ffdda8b9..af7b5b99f9b 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2983,7 +2983,7 @@ void gfc_add_class_array_ref (gfc_expr *); bool gfc_is_class_array_ref (gfc_expr *, bool *); bool gfc_is_class_scalar_expr (gfc_expr *); bool gfc_is_class_container_ref (gfc_expr *e); -gfc_expr *gfc_class_null_initializer (gfc_typespec *, gfc_expr *); +gfc_expr *gfc_class_initializer (gfc_typespec *, gfc_expr *); unsigned int gfc_hash_value (gfc_symbol *); bool gfc_build_class_symbol (gfc_typespec *, symbol_attribute *, gfc_array_spec **, bool); diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 2916b4cc52e..43f401d83d4 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1491,14 +1491,14 @@ gfc_get_symbol_decl (gfc_symbol * sym) SAVE is specified otherwise they need to be reinitialized every time the procedure is entered. The TREE_STATIC is in this case due to -fmax-stack-var-size=. */ + DECL_INITIAL (decl) = gfc_conv_initializer (sym->value, &sym->ts, - TREE_TYPE (decl), - sym->attr.dimension - || (sym->attr.codimension - && sym->attr.allocatable), - sym->attr.pointer - || sym->attr.allocatable, - sym->attr.proc_pointer); + TREE_TYPE (decl), sym->attr.dimension + || (sym->attr.codimension + && sym->attr.allocatable), + sym->attr.pointer || sym->attr.allocatable + || sym->ts.type == BT_CLASS, + sym->attr.proc_pointer); } if (!TREE_STATIC (decl) diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 74e95b08928..0801eee8b28 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5664,7 +5664,15 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespec * ts, tree type, } else if (pointer || procptr) { - if (!expr || expr->expr_type == EXPR_NULL) + if (ts->type == BT_CLASS && !procptr) + { + gfc_init_se (&se, NULL); + gfc_conv_structure (&se, gfc_class_initializer (ts, expr), 1); + gcc_assert (TREE_CODE (se.expr) == CONSTRUCTOR); + TREE_STATIC (se.expr) = 1; + return se.expr; + } + else if (!expr || expr->expr_type == EXPR_NULL) return fold_convert (type, null_pointer_node); else { @@ -5683,7 +5691,7 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespec * ts, tree type, case BT_CLASS: gfc_init_se (&se, NULL); if (ts->type == BT_CLASS && expr->expr_type == EXPR_NULL) - gfc_conv_structure (&se, gfc_class_null_initializer(ts, expr), 1); + gfc_conv_structure (&se, gfc_class_initializer (ts, expr), 1); else gfc_conv_structure (&se, expr, 1); gcc_assert (TREE_CODE (se.expr) == CONSTRUCTOR); @@ -5993,7 +6001,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr) { /* NULL initialization for CLASS components. */ tmp = gfc_trans_structure_assign (dest, - gfc_class_null_initializer (&cm->ts, expr)); + gfc_class_initializer (&cm->ts, expr)); gfc_add_expr_to_block (&block, tmp); } else if (cm->attr.dimension && !cm->attr.proc_pointer) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 92aff7a9f51..e8ac8604c76 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2013-08-06 Janus Weil + + PR fortran/57306 + * gfortran.dg/pointer_init_8.f90: New. + 2013-08-05 Paolo Carlini PR c++/58080 diff --git a/gcc/testsuite/gfortran.dg/pointer_init_8.f90 b/gcc/testsuite/gfortran.dg/pointer_init_8.f90 new file mode 100644 index 00000000000..aacd9a8e16e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pointer_init_8.f90 @@ -0,0 +1,26 @@ +! { dg-do run } +! +! PR 57306: [OOP] ICE on valid with class pointer initialization +! +! Contributed by Andrew Benson + +module m + type :: c + end type c + type, extends(c) :: d + end type d + type(c), target :: x + type(d), target :: y +end module m + + use m + class(c), pointer :: px => x + class(c), pointer :: py => y + + if (.not. associated(px, x)) call abort() + if (.not. same_type_as(px, x)) call abort() + if (.not. associated(py, y)) call abort() + if (.not. same_type_as(py, y)) call abort() +end + +! { dg-final { cleanup-modules "m" } } -- 2.11.4.GIT