diff options
| author | Tobias Burnus <burnus@gcc.gnu.org> | 2010-07-27 10:44:22 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2010-07-27 10:44:22 +0200 |
| commit | fb55ca75aed99996a52ea22ba5456c918e7e70c6 (patch) | |
| tree | 806144f554b32c6d406d7bddc3f6676634069925 /gcc/fortran/resolve.c | |
| parent | bec627e5aaa40fb2b5b11cb1e8bdda6b078e2b4c (diff) | |
| download | gcc-fb55ca75aed99996a52ea22ba5456c918e7e70c6.zip gcc-fb55ca75aed99996a52ea22ba5456c918e7e70c6.tar.gz gcc-fb55ca75aed99996a52ea22ba5456c918e7e70c6.tar.bz2 | |
re PR fortran/40873 (-fwhole-file -fwhole-program: Wrong decls cause too much to be optimized away)
2010-07-26 Tobias Burnus <burnus@net-b.de>
PR fortran/40873
* trans-decl.c (gfc_get_extern_function_decl): Fix generation
for functions which are later in the same file.
(gfc_create_function_decl, build_function_decl,
build_entry_thunks): Add global argument.
* trans.c (gfc_generate_module_code): Update
gfc_create_function_decl call.
* trans.h (gfc_create_function_decl): Update prototype.
* resolve.c (resolve_global_procedure): Also resolve for
IFSRC_IFBODY.
2010-07-26 Tobias Burnus <burnus@net-b.de>
PR fortran/40873
* gfortran.dg/whole_file_22.f90: New test.
* gfortran.dg/whole_file_23.f90: New test.
From-SVN: r162557
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 23 |
1 files changed, 15 insertions, 8 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index fb9aadc..dab533d 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1816,7 +1816,8 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, gfc_global_used (gsym, where); if (gfc_option.flag_whole_file - && sym->attr.if_source == IFSRC_UNKNOWN + && (sym->attr.if_source == IFSRC_UNKNOWN + || sym->attr.if_source == IFSRC_IFBODY) && gsym->type != GSYM_UNKNOWN && gsym->ns && gsym->ns->resolved != -1 @@ -1902,7 +1903,7 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, sym->name, &sym->declared_at, gfc_typename (&sym->ts), gfc_typename (&def_sym->ts)); - if (def_sym->formal) + if (def_sym->formal && sym->attr.if_source != IFSRC_IFBODY) { gfc_formal_arglist *arg = def_sym->formal; for ( ; arg; arg = arg->next) @@ -1969,14 +1970,19 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, where); /* F2003, 12.3.1.1 (3b); F2008, 12.4.2.2 (3b) */ - if (def_sym->result->attr.pointer - || def_sym->result->attr.allocatable) + if ((def_sym->result->attr.pointer + || def_sym->result->attr.allocatable) + && (sym->attr.if_source != IFSRC_IFBODY + || def_sym->result->attr.pointer + != sym->result->attr.pointer + || def_sym->result->attr.allocatable + != sym->result->attr.allocatable)) gfc_error ("Function '%s' at %L with a POINTER or ALLOCATABLE " "result must have an explicit interface", sym->name, where); /* F2003, 12.3.1.1 (3c); F2008, 12.4.2.2 (3c) */ - if (sym->ts.type == BT_CHARACTER + if (sym->ts.type == BT_CHARACTER && sym->attr.if_source != IFSRC_IFBODY && def_sym->ts.u.cl->length != NULL) { gfc_charlen *cl = sym->ts.u.cl; @@ -1992,14 +1998,14 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, } /* F2003, 12.3.1.1 (4); F2008, 12.4.2.2 (4) */ - if (def_sym->attr.elemental) + if (def_sym->attr.elemental && !sym->attr.elemental) { gfc_error ("ELEMENTAL procedure '%s' at %L must have an explicit " "interface", sym->name, &sym->declared_at); } /* F2003, 12.3.1.1 (5); F2008, 12.4.2.2 (5) */ - if (def_sym->attr.is_bind_c) + if (def_sym->attr.is_bind_c && !sym->attr.is_bind_c) { gfc_error ("Procedure '%s' at %L with BIND(C) attribute must have " "an explicit interface", sym->name, &sym->declared_at); @@ -2010,7 +2016,8 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, && !(gfc_option.warn_std & GFC_STD_GNU))) gfc_errors_to_warnings (1); - gfc_procedure_use (def_sym, actual, where); + if (sym->attr.if_source != IFSRC_IFBODY) + gfc_procedure_use (def_sym, actual, where); gfc_errors_to_warnings (0); } |