PR fortran/47745
* class.c (gfc_build_class_symbol): Set 'class_ok' attribute.
* decl.c (build_sym,attr_decl1): Move setting of 'class_ok' into
'gfc_build_class_symbol'.
(gfc_match_decl_type_spec): Reject unlimited polymorphism.
* interface.c (matching_typebound_op): Check for 'class_ok' attribute.
* match.c (select_type_set_tmp): Move setting of 'class_ok' into
'gfc_build_class_symbol'.
* primary.c (gfc_variable_attr): Check for 'class_ok' attribute.
2011-02-16 Janus Weil <janus@gcc.gnu.org>
PR fortran/47745
* gfortran.dg/class_39.f03: New.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@170223
138bc75d-0d04-0410-961f-
82ee72b054a4
+2011-02-16 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/47745
+ * class.c (gfc_build_class_symbol): Set 'class_ok' attribute.
+ * decl.c (build_sym,attr_decl1): Move setting of 'class_ok' into
+ 'gfc_build_class_symbol'.
+ (gfc_match_decl_type_spec): Reject unlimited polymorphism.
+ * interface.c (matching_typebound_op): Check for 'class_ok' attribute.
+ * match.c (select_type_set_tmp): Move setting of 'class_ok' into
+ 'gfc_build_class_symbol'.
+ * primary.c (gfc_variable_attr): Check for 'class_ok' attribute.
+
2011-02-15 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/47633
gfc_symbol *fclass;
gfc_symbol *vtab;
gfc_component *c;
+
+ if (attr->class_ok)
+ /* Class container has already been built. */
+ return SUCCESS;
+
+ attr->class_ok = attr->dummy || attr->pointer || attr->allocatable;
+
+ if (!attr->class_ok)
+ /* We can not build the class container yet. */
+ return SUCCESS;
if (*as)
{
sym->attr.implied_index = 0;
- if (sym->ts.type == BT_CLASS
- && (sym->attr.class_ok = sym->attr.dummy || sym->attr.pointer
- || sym->attr.allocatable))
+ if (sym->ts.type == BT_CLASS)
return gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false);
return SUCCESS;
ts->type = BT_DERIVED;
else
{
+ /* Match CLASS declarations. */
+ m = gfc_match (" class ( * )");
+ if (m == MATCH_ERROR)
+ return MATCH_ERROR;
+ else if (m == MATCH_YES)
+ {
+ gfc_fatal_error ("Unlimited polymorphism at %C not yet supported");
+ return MATCH_ERROR;
+ }
+
m = gfc_match (" class ( %n )", name);
if (m != MATCH_YES)
return m;
}
}
- if (sym->ts.type == BT_CLASS && !sym->attr.class_ok
- && (sym->attr.class_ok = sym->attr.class_ok || current_attr.allocatable
- || current_attr.pointer)
+ if (sym->ts.type == BT_CLASS
&& gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false) == FAILURE)
{
m = MATCH_ERROR;
gfc_try result;
if (base->expr->ts.type == BT_CLASS)
- derived = CLASS_DATA (base->expr)->ts.u.derived;
+ {
+ if (!gfc_expr_attr (base->expr).class_ok)
+ continue;
+ derived = CLASS_DATA (base->expr)->ts.u.derived;
+ }
else
derived = base->expr->ts.u.derived;
gfc_add_pointer (&tmp->n.sym->attr, NULL);
gfc_add_flavor (&tmp->n.sym->attr, FL_VARIABLE, name, NULL);
if (ts->type == BT_CLASS)
- {
- gfc_build_class_symbol (&tmp->n.sym->ts, &tmp->n.sym->attr,
- &tmp->n.sym->as, false);
- tmp->n.sym->attr.class_ok = 1;
- }
+ gfc_build_class_symbol (&tmp->n.sym->ts, &tmp->n.sym->attr,
+ &tmp->n.sym->as, false);
tmp->n.sym->attr.select_type_temporary = 1;
/* Add an association for it, so the rest of the parser knows it is
sym = expr->symtree->n.sym;
attr = sym->attr;
- if (sym->ts.type == BT_CLASS)
+ if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
{
dimension = CLASS_DATA (sym)->attr.dimension;
pointer = CLASS_DATA (sym)->attr.class_pointer;
+2011-02-16 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/47745
+ * gfortran.dg/class_39.f03: New.
+
2011-02-16 Dodji Seketeli <dodji@redhat.com>
PR c++/47326
--- /dev/null
+! { dg-do compile }
+!
+! PR 47745: [OOP] Segfault with CLASS(*) and derived type dummy arguments
+!
+! Contributed by Rodney Polkinghorne <thisrod@gmail.com>
+
+ type, abstract :: T
+ end type T
+contains
+ class(T) function add() ! { dg-error "must be dummy, allocatable or pointer" }
+ add = 1 ! { dg-error "Variable must not be polymorphic in assignment" }
+ end function
+end