diff options
| author | Daniel Kraft <d@domob.eu> | 2008-08-25 19:58:53 +0200 |
|---|---|---|
| committer | Daniel Kraft <domob@gcc.gnu.org> | 2008-08-25 19:58:53 +0200 |
| commit | 9d1210f47f50fa5a1e397632792aa97668e56e0e (patch) | |
| tree | 48f2f28391f6447501ac0481370dfd5b4e376e7c /gcc/fortran/resolve.c | |
| parent | e02aa5ec860b71931d3223505e0337ffb5d1a7a4 (diff) | |
| download | gcc-9d1210f47f50fa5a1e397632792aa97668e56e0e.zip gcc-9d1210f47f50fa5a1e397632792aa97668e56e0e.tar.gz gcc-9d1210f47f50fa5a1e397632792aa97668e56e0e.tar.bz2 | |
gfortran.h (gfc_find_component): Add new arguments.
2008-08-25 Daniel Kraft <d@domob.eu>
* gfortran.h (gfc_find_component): Add new arguments.
* parse.c (parse_derived_contains): Check if the derived-type containing
the CONTAINS section is SEQUENCE/BIND(C).
* resolve.c (resolve_typebound_procedure): Check for name collision with
components.
(resolve_fl_derived): Check for name collision with inherited
type-bound procedures.
* symbol.c (gfc_find_component): New arguments `noaccess' and `silent'.
(gfc_add_component): Adapt for new arguments.
* primary.c (match_varspec), (gfc_match_structure_constructor): Ditto.
2008-08-25 Daniel Kraft <d@domob.eu>
* gfortran.dg/extends_7.f03: New test.
* gfortran.dg/typebound_proc_7.f03: New test.
* gfortran.dg/typebound_proc_8.f03: New test.
From-SVN: r139566
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 33 |
1 files changed, 33 insertions, 0 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 9cde435..6bf5380 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -7800,6 +7800,7 @@ resolve_typebound_procedure (gfc_symtree* stree) locus where; gfc_symbol* me_arg; gfc_symbol* super_type; + gfc_component* comp; /* If this is no type-bound procedure, just return. */ if (!stree->typebound) @@ -7898,6 +7899,25 @@ resolve_typebound_procedure (gfc_symtree* stree) goto error; } + /* See if there's a name collision with a component directly in this type. */ + for (comp = resolve_bindings_derived->components; comp; comp = comp->next) + if (!strcmp (comp->name, stree->name)) + { + gfc_error ("Procedure '%s' at %L has the same name as a component of" + " '%s'", + stree->name, &where, resolve_bindings_derived->name); + goto error; + } + + /* Try to find a name collision with an inherited component. */ + if (super_type && gfc_find_component (super_type, stree->name, true, true)) + { + gfc_error ("Procedure '%s' at %L has the same name as an inherited" + " component of '%s'", + stree->name, &where, resolve_bindings_derived->name); + goto error; + } + /* FIXME: Remove once typebound-procedures are fully implemented. */ { /* Output the error only once so we can do reasonable testing. */ @@ -7954,11 +7974,24 @@ add_dt_to_dt_list (gfc_symbol *derived) static gfc_try resolve_fl_derived (gfc_symbol *sym) { + gfc_symbol* super_type; gfc_component *c; int i; + super_type = gfc_get_derived_super_type (sym); + for (c = sym->components; c != NULL; c = c->next) { + /* If this type is an extension, see if this component has the same name + as an inherited type-bound procedure. */ + if (super_type && gfc_find_typebound_proc (super_type, c->name)) + { + gfc_error ("Component '%s' of '%s' at %L has the same name as an" + " inherited type-bound procedure", + c->name, sym->name, &c->loc); + return FAILURE; + } + if (c->ts.type == BT_CHARACTER) { if (c->ts.cl->length == NULL |