From 35820014157910c5bf152c8f20a48d01fcff064c Mon Sep 17 00:00:00 2001 From: janus Date: Wed, 5 May 2010 07:44:33 +0000 Subject: 2010-05-05 Janus Weil PR fortran/43696 * resolve.c (resolve_fl_derived): Some fixes for class variables. * symbol.c (gfc_build_class_symbol): Add separate class container for class pointers. 2010-05-05 Janus Weil PR fortran/43696 * gfortran.dg/class_17.f03: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159056 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 7 +++++++ gcc/fortran/resolve.c | 14 ++++++++++++-- gcc/fortran/symbol.c | 2 ++ 3 files changed, 21 insertions(+), 2 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e61c7371110..0641cbfab67 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2010-05-05 Janus Weil + + PR fortran/43696 + * resolve.c (resolve_fl_derived): Some fixes for class variables. + * symbol.c (gfc_build_class_symbol): Add separate class container for + class pointers. + 2010-05-03 Steven G. Kargl PR fortran/43592 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 93c5b484ce0..d92c69c030c 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10794,7 +10794,7 @@ resolve_fl_derived (gfc_symbol *sym) /* If this type is an extension, see if this component has the same name as an inherited type-bound procedure. */ - if (super_type + if (super_type && !sym->attr.is_class && gfc_find_typebound_proc (super_type, NULL, c->name, true, NULL)) { gfc_error ("Component '%s' of '%s' at %L has the same name as an" @@ -10841,7 +10841,7 @@ resolve_fl_derived (gfc_symbol *sym) } } - if (c->ts.type == BT_DERIVED && c->attr.pointer + if (!sym->attr.is_class && c->ts.type == BT_DERIVED && c->attr.pointer && c->ts.u.derived->components == NULL && !c->ts.u.derived->attr.zero_comp) { @@ -10851,6 +10851,16 @@ resolve_fl_derived (gfc_symbol *sym) return FAILURE; } + if (c->ts.type == BT_CLASS && c->ts.u.derived->components->attr.pointer + && c->ts.u.derived->components->ts.u.derived->components == NULL + && !c->ts.u.derived->components->ts.u.derived->attr.zero_comp) + { + gfc_error ("The pointer component '%s' of '%s' at %L is a type " + "that has not been declared", c->name, sym->name, + &c->loc); + return FAILURE; + } + /* C437. */ if (c->ts.type == BT_CLASS && !(c->ts.u.derived->components->attr.pointer diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index b19714cfca6..8403578b81e 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -4720,6 +4720,8 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, sprintf (name, ".class.%s.%d.a", ts->u.derived->name, (*as)->rank); else if ((*as) && (*as)->rank) sprintf (name, ".class.%s.%d", ts->u.derived->name, (*as)->rank); + else if (attr->pointer) + sprintf (name, ".class.%s.p", ts->u.derived->name); else if (attr->allocatable) sprintf (name, ".class.%s.a", ts->u.derived->name); else -- cgit v1.2.1