PR fortran/43207
PR fortran/43969
* gfortran.h (gfc_class_null_initializer): New prototype.
* expr.c (gfc_class_null_initializer): New function to build a NULL
initializer for CLASS pointers.
* symbol.c (gfc_build_class_symbol): Modify internal naming of class
containers. Remove default NULL initialization of $data component.
* trans.c (gfc_allocate_array_with_status): Fix wording of an error
message.
* trans-expr.c (gfc_conv_initializer,gfc_trans_subcomponent_assign):
Use new function 'gfc_class_null_initializer'.
* trans-intrinsic.c (gfc_conv_allocated): Handle allocatable scalar
class variables.
2010-05-15 Janus Weil <janus@gcc.gnu.org>
PR fortran/43207
PR fortran/43969
* gfortran.dg/class_18.f03: New.
* gfortran.dg/class_19.f03: New.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159431
138bc75d-0d04-0410-961f-
82ee72b054a4
+2010-05-15 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/43207
+ PR fortran/43969
+ * gfortran.h (gfc_class_null_initializer): New prototype.
+ * expr.c (gfc_class_null_initializer): New function to build a NULL
+ initializer for CLASS pointers.
+ * symbol.c (gfc_build_class_symbol): Modify internal naming of class
+ containers. Remove default NULL initialization of $data component.
+ * trans.c (gfc_allocate_array_with_status): Fix wording of an error
+ message.
+ * trans-expr.c (gfc_conv_initializer,gfc_trans_subcomponent_assign):
+ Use new function 'gfc_class_null_initializer'.
+ * trans-intrinsic.c (gfc_conv_allocated): Handle allocatable scalar
+ class variables.
+
2010-05-14 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/44135
2010-05-14 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/44135
+/* Build a NULL initializer for CLASS pointers,
+ initializing the $data and $vptr components to zero. */
+
+gfc_expr *
+gfc_class_null_initializer (gfc_typespec *ts)
+{
+ gfc_expr *init;
+ gfc_component *comp;
+
+ init = gfc_get_structure_constructor_expr (ts->type, ts->kind,
+ &ts->u.derived->declared_at);
+ init->ts = *ts;
+
+ for (comp = ts->u.derived->components; comp; comp = comp->next)
+ {
+ gfc_constructor *ctor = gfc_constructor_get();
+ ctor->expr = gfc_get_expr ();
+ ctor->expr->expr_type = EXPR_NULL;
+ ctor->expr->ts = comp->ts;
+ gfc_constructor_append (&init->value.constructor, ctor);
+ }
+
+ return init;
+}
+
+
/* Given a symbol, create an expression node with that symbol as a
variable. If the symbol is array valued, setup a reference of the
whole array. */
/* Given a symbol, create an expression node with that symbol as a
variable. If the symbol is array valued, setup a reference of the
whole array. */
gfc_try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *);
gfc_expr *gfc_default_initializer (gfc_typespec *);
gfc_try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *);
gfc_expr *gfc_default_initializer (gfc_typespec *);
+gfc_expr *gfc_class_null_initializer (gfc_typespec *);
gfc_expr *gfc_get_variable_expr (gfc_symtree *);
gfc_array_spec *gfc_get_full_arrayspec_from_expr (gfc_expr *expr);
gfc_expr *gfc_get_variable_expr (gfc_symtree *);
gfc_array_spec *gfc_get_full_arrayspec_from_expr (gfc_expr *expr);
/* Determine the name of the encapsulating type. */
if ((*as) && (*as)->rank && attr->allocatable)
/* Determine the name of the encapsulating type. */
if ((*as) && (*as)->rank && attr->allocatable)
- sprintf (name, ".class.%s.%d.a", ts->u.derived->name, (*as)->rank);
+ sprintf (name, "class$%s_%d_a", ts->u.derived->name, (*as)->rank);
else if ((*as) && (*as)->rank)
else if ((*as) && (*as)->rank)
- sprintf (name, ".class.%s.%d", ts->u.derived->name, (*as)->rank);
+ sprintf (name, "class$%s_%d", ts->u.derived->name, (*as)->rank);
- sprintf (name, ".class.%s.p", ts->u.derived->name);
+ sprintf (name, "class$%s_p", ts->u.derived->name);
else if (attr->allocatable)
else if (attr->allocatable)
- sprintf (name, ".class.%s.a", ts->u.derived->name);
+ sprintf (name, "class$%s_a", ts->u.derived->name);
- sprintf (name, ".class.%s", ts->u.derived->name);
+ sprintf (name, "class$%s", ts->u.derived->name);
gfc_find_symbol (name, ts->u.derived->ns, 0, &fclass);
if (fclass == NULL)
gfc_find_symbol (name, ts->u.derived->ns, 0, &fclass);
if (fclass == NULL)
c->attr.codimension = attr->codimension;
c->attr.abstract = ts->u.derived->attr.abstract;
c->as = (*as);
c->attr.codimension = attr->codimension;
c->attr.abstract = ts->u.derived->attr.abstract;
c->as = (*as);
- c->initializer = gfc_get_null_expr (NULL);
/* Add component '$vptr'. */
if (gfc_add_component (fclass, "$vptr", &c) == FAILURE)
/* Add component '$vptr'. */
if (gfc_add_component (fclass, "$vptr", &c) == FAILURE)
case BT_DERIVED:
case BT_CLASS:
gfc_init_se (&se, NULL);
case BT_DERIVED:
case BT_CLASS:
gfc_init_se (&se, NULL);
- gfc_conv_structure (&se, expr, 1);
+ if (ts->type == BT_CLASS && expr->expr_type == EXPR_NULL)
+ gfc_conv_structure (&se, gfc_class_null_initializer(ts), 1);
+ else
+ gfc_conv_structure (&se, expr, 1);
return se.expr;
case BT_CHARACTER:
return se.expr;
case BT_CHARACTER:
{
/* NULL initialization for CLASS components. */
tmp = gfc_trans_structure_assign (dest,
{
/* NULL initialization for CLASS components. */
tmp = gfc_trans_structure_assign (dest,
- gfc_default_initializer (&cm->ts));
+ gfc_class_null_initializer (&cm->ts));
gfc_add_expr_to_block (&block, tmp);
}
else if (cm->attr.dimension)
gfc_add_expr_to_block (&block, tmp);
}
else if (cm->attr.dimension)
+2010-05-15 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/43207
+ PR fortran/43969
+ * gfortran.dg/class_18.f03: New.
+ * gfortran.dg/class_19.f03: New.
+
2010-05-14 Jakub Jelinek <jakub@redhat.com>
PR debug/44112
2010-05-14 Jakub Jelinek <jakub@redhat.com>
PR debug/44112