| Message ID | 4C4DF0D7.2020001@net-b.de |
|---|---|
| State | New |
| Headers | show |
Le 26.07.2010 22:32, Tobias Burnus a écrit : > Dear all, > > the attached patch is rather obvious - after one has found the right spots. > > a) If Fortran tried first to resolve "call proc()" and then only > generated the code for "subroutine proc()", two separate declarations > where created - thus the decl of "subroutine proc()" was never called -- > and therefore, with -fwhole-program, "subroutine proc()" was optimized > away - causing linker errors. > > The solution is simple: When obtaining the external decl, first generate > the decl for the real procedure - and place it at the global binding level. > > b) gfortran did not properly resolve procedures if they were declared > with INTERFACE, causing crashes for assumed-shape dummies. For those, > one needs to change the dummy from AS_DEFERRED to AS_ASSUMED_SHAPE, but > this was not be done for the real global symbol. Well, as consequence, > one got an ICE in trans*.c when treating it as AS_DEFERRED array. > > The solution was to also handle INTERFACE; afterwards, I had to adapt > (and to conditionally disable) some checks. > > > Build and and currently regtesting on x86-64-linux. If there is no failure: > OK for the trunk? The extra expr.c hunk (pr45081 fix) which slipped through, is ok (and obvious). The function decl changes are OK. For the interface thing see below. > Index: gcc/fortran/resolve.c > =================================================================== > --- gcc/fortran/resolve.c (Revision 162542) > +++ gcc/fortran/resolve.c (Arbeitskopie) > @@ -1816,7 +1816,8 @@ resolve_global_procedure (gfc_symbol *sy > 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 *sy > 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 *sy > 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 The above makes sense, but the 4 following lines are odd. If I understand it correctly if there is a function definition/interface mismatch (between pointer or allocatable attributes), we generate an error asking for explicit interface (even if the symbol comes from an interface block which _is_ an explicit interface). Well, maybe it's better than nothing after all. > + || def_sym->result->attr.pointer > + != sym->result->attr.pointer) There is an extra parenthesis here > + || (def_sym->result->attr.allocatable And another one here > + != 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 This is going past the 80th character (OK, very minor ;) ) > && def_sym->ts.u.cl->length != NULL) > { > gfc_charlen *cl = sym->ts.u.cl; > @@ -1992,14 +1998,14 @@ resolve_global_procedure (gfc_symbol *sy > } > > /* 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) Same as above, I would put if (def_sym->attr.elemental && sym->attr.if_source != IFSRC_IFBODY) like in the previous cases. It is odd to guess interface explicitness out of symbol elementalness. > { > 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) Same here. > { > 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 *sy > && !(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); > } The comments above are about cases where procedure definitions don't match the corresponding interfaces, which makes them invalid. As the previous status (without -fwhole-file) was not to check at all and the patch doesn't seem to error on valid testcases, OK if it passes the testsuite. I may try to find testcases for my comments above tomorrow. Mikael
Mikael Morin wrote: > Le 26.07.2010 22:32, Tobias Burnus a écrit : >> Build and and currently regtesting on x86-64-linux. If there is no >> failure: >> OK for the trunk? > The extra expr.c hunk (pr45081 fix) which slipped through, is ok (and > obvious). But regresses in terms of diagnostics - I will leave it out and have a separate look later. > For the interface thing see below. /* 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 > The above makes sense, but the 4 following lines are odd. > > If I understand it correctly if there is a function > definition/interface mismatch (between pointer or allocatable > attributes), we generate an error asking for explicit interface (even > if the symbol comes from an interface block which _is_ an explicit > interface). > Well, maybe it's better than nothing after all. That was my idea - I think interface mismatches are rare enough that one does not need to replicate all the messages - and the error might be slightly odd, but should give a good hint. >> + || def_sym->result->attr.pointer >> + != sym->result->attr.pointer) > There is an extra parenthesis here I concur. >> + || (def_sym->result->attr.allocatable > And another one here I concur. With those changes - which I spotted after I had send the email (but did not want to send a reply before testing finished), regtesting succeeded. >> && def_sym->ts.u.cl->length != NULL) >> { >> gfc_charlen *cl = sym->ts.u.cl; >> @@ -1992,14 +1998,14 @@ resolve_global_procedure (gfc_symbol *sy >> } >> >> /* 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) > Same as above, I would put > if (def_sym->attr.elemental && sym->attr.if_source != IFSRC_IFBODY) > like in the previous cases. > It is odd to guess interface explicitness out of symbol elementalness. Well, I want to print also an error if the INTERFACE has no ELEMENTAL - I could split the message in one for IFSRC_IFBODY and one for wrong interfaces, if you think it makes sense. >> - if (def_sym->attr.is_bind_c) >> + if (def_sym->attr.is_bind_c && !sym->attr.is_bind_c) > Same here. Ditto. Thanks for the review! Tobias
On 07/27/2010 01:15 AM, Mikael Morin wrote: > Le 26.07.2010 22:32, Tobias Burnus a écrit : >> Build and and currently regtesting on x86-64-linux. If there is no >> failure: >> OK for the trunk? > The extra expr.c hunk (pr45081 fix) which slipped through, is ok (and > obvious). > The function decl changes are OK. > [...] > As the previous status (without -fwhole-file) was not to check at all > and the patch doesn't seem to error on valid testcases, OK if it > passes the testsuite. Committed as Rev. 162557 with the parentheses fixes in resolve.c (for allocatable/pointer) and without the expr.c patch. http://gcc.gnu.org/ml/gcc-cvs/2010-07/msg00911.html Regarding the resolve.c checks: You can also consider adding a comment to PR 45086 - there I track the external vs. INTERFACE checking for -fwhole-file. Tobias
Le 27.07.2010 07:54, Tobias Burnus a écrit : > > Mikael Morin wrote: >> Le 26.07.2010 22:32, Tobias Burnus a écrit : >>> Build and and currently regtesting on x86-64-linux. If there is no >>> failure: >>> OK for the trunk? >> The extra expr.c hunk (pr45081 fix) which slipped through, is ok (and >> obvious). > But regresses in terms of diagnostics - I will leave it out and have a > separate look later. > >> For the interface thing see below. /* 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 >> The above makes sense, but the 4 following lines are odd. >> >> If I understand it correctly if there is a function >> definition/interface mismatch (between pointer or allocatable >> attributes), we generate an error asking for explicit interface (even >> if the symbol comes from an interface block which _is_ an explicit >> interface). >> Well, maybe it's better than nothing after all. > > That was my idea - I think interface mismatches are rare enough that one > does not need to replicate all the messages - and the error might be > slightly odd, but should give a good hint. OK, we can wait for someone to open a PR(if any) to decide to do something here. > >>> + || def_sym->result->attr.pointer >>> + != sym->result->attr.pointer) >> There is an extra parenthesis here > I concur. > >>> + || (def_sym->result->attr.allocatable >> And another one here > > I concur. With those changes - which I spotted after I had send the > email (but did not want to send a reply before testing finished), > regtesting succeeded. > > >>> && def_sym->ts.u.cl->length != NULL) >>> { >>> gfc_charlen *cl = sym->ts.u.cl; >>> @@ -1992,14 +1998,14 @@ resolve_global_procedure (gfc_symbol *sy >>> } >>> >>> /* 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) >> Same as above, I would put >> if (def_sym->attr.elemental&& sym->attr.if_source != IFSRC_IFBODY) >> like in the previous cases. >> It is odd to guess interface explicitness out of symbol elementalness. > > Well, I want to print also an error if the INTERFACE has no ELEMENTAL - > I could split the message in one for IFSRC_IFBODY and one for wrong > interfaces, if you think it makes sense. I was afraid that one could come up with a case where both def_sym and sym were declared as elemental (without interface body), thus skipping the check. I can't produce one, however, so it's probably fine as is. > >>> - if (def_sym->attr.is_bind_c) >>> + if (def_sym->attr.is_bind_c&& !sym->attr.is_bind_c) >> Same here. > > Ditto. Same here. No failing testcase. > > Thanks for the review! > > Tobias > Thanks for all your whole-file work. Mikael
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. Index: gcc/testsuite/gfortran.dg/whole_file_23.f90 =================================================================== --- gcc/testsuite/gfortran.dg/whole_file_23.f90 (Revision 0) +++ gcc/testsuite/gfortran.dg/whole_file_23.f90 (Revision 0) @@ -0,0 +1,49 @@ +! { dg-do compile } +! +! PR fortran/40873 +! +! Failed to compile (segfault) with -fwhole-file. +! Cf. PR 40873 comment 24; test case taken from +! PR fortran/31867 comment 6. +! + +pure integer function lensum (words, sep) + character (len=*), intent(in) :: words(:), sep + lensum = (size (words)-1) * len (sep) + sum (len_trim (words)) +end function + +module util_mod + implicit none + interface + pure integer function lensum (words, sep) + character (len=*), intent(in) :: words(:), sep + end function + end interface + contains + function join (words, sep) result(str) +! trim and concatenate a vector of character variables, +! inserting sep between them + character (len=*), intent(in) :: words(:), sep + character (len=lensum (words, sep)) :: str + integer :: i, nw + nw = size (words) + str = "" + if (nw < 1) then + return + else + str = words(1) + end if + do i=2,nw + str = trim (str) // sep // words(i) + end do + end function join +end module util_mod +! +program xjoin + use util_mod, only: join + implicit none + character (len=5) :: words(2) = (/"two ","three"/) + write (*,"(1x,'words = ',a)") "'"//join (words, "&")//"'" +end program xjoin + +! { dg-final { cleanup-modules "util_mod" } } Index: gcc/testsuite/gfortran.dg/whole_file_22.f90 =================================================================== --- gcc/testsuite/gfortran.dg/whole_file_22.f90 (Revision 0) +++ gcc/testsuite/gfortran.dg/whole_file_22.f90 (Revision 0) @@ -0,0 +1,38 @@ +! { dg-do link } +! { dg-options "-fwhole-program -O3 -g" } +! +! PR fortran/40873 +! + program prog + call one() + call two() + call test() + end program prog + subroutine one() + call three() + end subroutine one + subroutine two() + call three() + end subroutine two + subroutine three() + end subroutine three + +SUBROUTINE c() + CALL a() +END SUBROUTINE c + +SUBROUTINE a() +END SUBROUTINE a + +MODULE M +CONTAINS + SUBROUTINE b() + CALL c() + END SUBROUTINE +END MODULE + +subroutine test() +USE M +CALL b() +END + Index: gcc/fortran/expr.c =================================================================== --- gcc/fortran/expr.c (Revision 162542) +++ gcc/fortran/expr.c (Arbeitskopie) @@ -913,7 +913,7 @@ gfc_is_constant_expr (gfc_expr *e) || gfc_is_constant_expr (e->value.op.op2))); case EXPR_VARIABLE: - return 0; + return (e->symtree->n.sym->attr.flavour == FL_PARAMETER); case EXPR_FUNCTION: case EXPR_PPC: Index: gcc/fortran/trans.c =================================================================== --- gcc/fortran/trans.c (Revision 162542) +++ gcc/fortran/trans.c (Arbeitskopie) @@ -1388,7 +1388,7 @@ gfc_generate_module_code (gfc_namespace if (!n->proc_name) continue; - gfc_create_function_decl (n); + gfc_create_function_decl (n, false); gcc_assert (DECL_CONTEXT (n->proc_name->backend_decl) == NULL_TREE); DECL_CONTEXT (n->proc_name->backend_decl) = ns->proc_name->backend_decl; gfc_module_add_decl (entry, n->proc_name->backend_decl); Index: gcc/fortran/trans.h =================================================================== --- gcc/fortran/trans.h (Revision 162542) +++ gcc/fortran/trans.h (Arbeitskopie) @@ -449,7 +449,7 @@ void gfc_allocate_lang_decl (tree); tree gfc_advance_chain (tree, int); /* Create a decl for a function. */ -void gfc_create_function_decl (gfc_namespace *); +void gfc_create_function_decl (gfc_namespace *, bool); /* Generate the code for a function. */ void gfc_generate_function_code (gfc_namespace *); /* Output a BLOCK DATA program unit. */ @@ -537,7 +537,7 @@ void gfc_process_block_locals (gfc_names /* Output initialization/clean-up code that was deferred. */ void gfc_trans_deferred_vars (gfc_symbol*, gfc_wrapped_block *); -/* somewhere! */ +/* In f95-lang.c. */ tree pushdecl (tree); tree pushdecl_top_level (tree); void pushlevel (int); @@ -545,6 +545,8 @@ tree poplevel (int, int, int); tree getdecls (void); tree gfc_truthvalue_conversion (tree); tree gfc_builtin_function (tree); + +/* In trans-types.c. */ struct array_descr_info; bool gfc_get_array_descr_info (const_tree, struct array_descr_info *); Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (Revision 162542) +++ gcc/fortran/resolve.c (Arbeitskopie) @@ -1816,7 +1816,8 @@ resolve_global_procedure (gfc_symbol *sy 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 *sy 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 *sy 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 *sy } /* 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 *sy && !(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); } Index: gcc/fortran/trans-decl.c =================================================================== --- gcc/fortran/trans-decl.c (Revision 162542) +++ gcc/fortran/trans-decl.c (Arbeitskopie) @@ -1413,8 +1413,26 @@ gfc_get_extern_function_decl (gfc_symbol && !sym->backend_decl && gsym && gsym->ns && ((gsym->type == GSYM_SUBROUTINE) || (gsym->type == GSYM_FUNCTION)) - && gsym->ns->proc_name->backend_decl) + && (gsym->ns->proc_name->backend_decl || !sym->attr.intrinsic)) { + if (!gsym->ns->proc_name->backend_decl) + { + /* By construction, the external function cannot be + a contained procedure. */ + locus old_loc; + tree save_fn_decl = current_function_decl; + + current_function_decl = NULL_TREE; + gfc_get_backend_locus (&old_loc); + push_cfun (cfun); + + gfc_create_function_decl (gsym->ns, true); + + pop_cfun (); + gfc_set_backend_locus (&old_loc); + current_function_decl = save_fn_decl; + } + /* If the namespace has entries, the proc_name is the entry master. Find the entry and use its backend_decl. otherwise, use the proc_name backend_decl. */ @@ -1574,7 +1592,7 @@ gfc_get_extern_function_decl (gfc_symbol a master function with alternate entry points. */ static void -build_function_decl (gfc_symbol * sym) +build_function_decl (gfc_symbol * sym, bool global) { tree fndecl, type, attributes; symbol_attribute attr; @@ -1682,7 +1700,11 @@ build_function_decl (gfc_symbol * sym) /* Layout the function declaration and put it in the binding level of the current function. */ - pushdecl (fndecl); + + if (global) + pushdecl_top_level (fndecl); + else + pushdecl (fndecl); sym->backend_decl = fndecl; } @@ -1955,7 +1977,7 @@ trans_function_start (gfc_symbol * sym) /* Create thunks for alternate entry points. */ static void -build_entry_thunks (gfc_namespace * ns) +build_entry_thunks (gfc_namespace * ns, bool global) { gfc_formal_arglist *formal; gfc_formal_arglist *thunk_formal; @@ -1977,7 +1999,7 @@ build_entry_thunks (gfc_namespace * ns) thunk_sym = el->sym; - build_function_decl (thunk_sym); + build_function_decl (thunk_sym, global); create_function_arglist (thunk_sym); trans_function_start (thunk_sym); @@ -2137,17 +2159,18 @@ build_entry_thunks (gfc_namespace * ns) /* Create a decl for a function, and create any thunks for alternate entry - points. */ + points. If global is true, generate the function in the global binding + level, otherwise in the current binding level (which can be global). */ void -gfc_create_function_decl (gfc_namespace * ns) +gfc_create_function_decl (gfc_namespace * ns, bool global) { /* Create a declaration for the master function. */ - build_function_decl (ns->proc_name); + build_function_decl (ns->proc_name, global); /* Compile the entry thunks. */ if (ns->entries) - build_entry_thunks (ns); + build_entry_thunks (ns, global); /* Now create the read argument list. */ create_function_arglist (ns->proc_name); @@ -3728,7 +3751,7 @@ gfc_generate_contained_functions (gfc_na if (ns->parent != parent) continue; - gfc_create_function_decl (ns); + gfc_create_function_decl (ns, false); } for (ns = parent->contained; ns; ns = ns->sibling) @@ -4364,7 +4387,7 @@ gfc_generate_function_code (gfc_namespac /* Create the declaration for functions with global scope. */ if (!sym->backend_decl) - gfc_create_function_decl (ns); + gfc_create_function_decl (ns, false); fndecl = sym->backend_decl; old_context = current_function_decl;