From patchwork Sun Feb 3 21:34:50 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Subject: [fortran] PR54107: ICE on recursive interfaces and PR54195: symbol bogusly inserted twice in the interface. Date: Sun, 03 Feb 2013 11:34:50 -0000 From: Mikael Morin X-Patchwork-Id: 217809 Message-Id: <510ED7FA.2050900@sfr.fr> To: gfortran , gcc-patches Hello, The following patches fix both PR54107 and PR54195. - In PR54107(comment 26), the procedure result is a procedure pointer whose interface is the procedure itself, which leads to an infinite recursion during resolution. - In PR54195, a type's type bound procedures are resolved twice, leading to a symbol being added twice in an interface and rejected. The fix, as discussed in PR54195, adds a flag to mark a symbol as resolved. This leads to two regressions. For class_20, a check to skip result symbols had to be removed (which was there to avoid duplicated resolution). For initialization_27 (among a few others) the code adding the default initialization code was guarded by a check against gfc_current_ns, which always ended triggering when there was more than one resolution but may not anymore. The fix removes it; I checked that gfc_current_ns wasn't used in the following code. The second fix makes the recursion through resolve_symbol, so that the flag just added triggers and PR54195 is fixed. Regression tested on x86_64-unknown-linux-gnu. OK for trunk? Mikael 2013-02-03 Mikael Morin PR fortran/54107 PR fortran/54195 * gfortran.h (struct symbol_attribute): New field 'resolved'. * resolve.c (resolve_fl_var_and_proc): Don't skip result symbols. (resolve_symbol): Skip duplicate calls. Don' check the current namespace. 2013-02-03 Mikael Morin PR fortran/54107 * gfortran.dg/recursive_interface_1.f90: New test. 2013-02-03 Mikael Morin PR fortran/54195 * resolve.c (resolve_typebound_procedures): Recurse through resolve_symbol. 2013-02-03 Mikael Morin PR fortran/54195 * gfortran.dg/defined_assignment_4.f90: New test. * gfortran.dg/defined_assignment_5.f90: New test. diff --git a/resolve.c b/resolve.c index 3b74c6f..6bec662 100644 --- a/resolve.c +++ b/resolve.c @@ -12344,7 +12344,7 @@ resolve_typebound_procedures (gfc_symbol* derived) super_type = gfc_get_derived_super_type (derived); if (super_type) - resolve_typebound_procedures (super_type); + resolve_symbol (super_type); resolve_bindings_derived = derived; resolve_bindings_result = SUCCESS; diff --git a/gfortran.h b/gfortran.h index 16751b4..af2b45a 100644 --- a/gfortran.h +++ b/gfortran.h @@ -810,6 +810,9 @@ typedef struct /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */ unsigned ext_attr:EXT_ATTR_NUM; + /* Used to avoid multiple resolutions of a single symbol. */ + unsigned resolved:1; + /* The namespace where the attribute has been set. */ struct gfc_namespace *volatile_ns, *asynchronous_ns; } diff --git a/resolve.c b/resolve.c index d6bae43..3b74c6f 100644 --- a/resolve.c +++ b/resolve.c @@ -11051,11 +11051,6 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag) { gfc_array_spec *as; - /* Avoid double diagnostics for function result symbols. */ - if ((sym->result || sym->attr.result) && !sym->attr.dummy - && (sym->ns != gfc_current_ns)) - return SUCCESS; - if (sym->ts.type == BT_CLASS && sym->attr.class_ok) as = CLASS_DATA (sym)->as; else @@ -13170,6 +13165,10 @@ resolve_symbol (gfc_symbol *sym) gfc_array_spec *as; bool saved_specification_expr; + if (sym->attr.resolved) + return; + sym->attr.resolved = 1; + if (sym->attr.artificial) return; @@ -13779,7 +13778,6 @@ resolve_symbol (gfc_symbol *sym) described in 14.7.5, to those variables that have not already been assigned one. */ if (sym->ts.type == BT_DERIVED - && sym->ns == gfc_current_ns && !sym->value && !sym->attr.allocatable && !sym->attr.alloc_comp)