diff options
| author | Tobias Burnus <burnus@net-b.de> | 2011-04-29 18:49:53 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2011-04-29 18:49:53 +0200 |
| commit | 12578be73d300173f75624b75d1336d17d97c116 (patch) | |
| tree | 9644e56190962060adbebba7e4e07176fe353047 /gcc/fortran/resolve.c | |
| parent | 176f076f050ffd64e785c6ed12937879d7b0eda4 (diff) | |
| download | gcc-12578be73d300173f75624b75d1336d17d97c116.zip gcc-12578be73d300173f75624b75d1336d17d97c116.tar.gz gcc-12578be73d300173f75624b75d1336d17d97c116.tar.bz2 | |
re PR fortran/48810 ([OOP] TPB rejected because module procedure is private)
2011-04-29 Tobias Burnus <burnus@net-b.de>
PR fortran/48810
* resolve.c (resolve_typebound_generic_call): Don't check access
flags of the specific function.
PR fortran/48800
* resolve.c (resolve_formal_arglist): Don't change AS_DEFERRED
to AS_ASSUMED_SHAPE for function results.
(resolve_fl_var_and_proc): Print also for function results with
AS_DEFERRED an error, if they are not a pointer or allocatable.
(resolve_types): Make sure arguments of procedures in interface
blocks are resolved.
2011-04-29 Tobias Burnus <burnus@net-b.de>
PR fortran/48810
* gfortran.dg/typebound_proc_22.f90: New.
PR fortran/48800
* gfortran.dg/interface_36.f90: New.
From-SVN: r173175
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 11 |
1 files changed, 8 insertions, 3 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 7fed7a5..a19b103 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -315,7 +315,8 @@ resolve_formal_arglist (gfc_symbol *proc) shape until we know if it has the pointer or allocatable attributes. */ if (sym->as && sym->as->rank > 0 && sym->as->type == AS_DEFERRED - && !(sym->attr.pointer || sym->attr.allocatable)) + && !(sym->attr.pointer || sym->attr.allocatable) + && sym->attr.flavor != FL_PROCEDURE) { sym->as->type = AS_ASSUMED_SHAPE; for (i = 0; i < sym->as->rank; i++) @@ -5684,7 +5685,7 @@ success: /* Make sure that we have the right specific instance for the name. */ derived = get_declared_from_expr (NULL, NULL, e); - st = gfc_find_typebound_proc (derived, NULL, genname, false, &e->where); + st = gfc_find_typebound_proc (derived, NULL, genname, true, &e->where); if (st) e->value.compcall.tbp = st->n.tb; @@ -9918,7 +9919,7 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag) else { if (!mp_flag && !sym->attr.allocatable && !sym->attr.pointer - && !sym->attr.dummy && sym->ts.type != BT_CLASS && !sym->assoc) + && sym->ts.type != BT_CLASS && !sym->assoc) { gfc_error ("Array '%s' at %L cannot have a deferred shape", sym->name, &sym->declared_at); @@ -13533,6 +13534,10 @@ resolve_types (gfc_namespace *ns) resolve_contained_functions (ns); + if (ns->proc_name && ns->proc_name->attr.flavor == FL_PROCEDURE + && ns->proc_name->attr.if_source == IFSRC_IFBODY) + resolve_formal_arglist (ns->proc_name); + gfc_traverse_ns (ns, resolve_bind_c_derived_types); for (cl = ns->cl_list; cl; cl = cl->next) |