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 <[email protected]>
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 <[email protected]>
PR fortran/54107
* gfortran.dg/recursive_interface_1.f90: New test.
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)
! { dg-do compile }
!
! PR fortran/54107
! The compiler used to ICE on recursive interfaces.
module m
contains
function foo() result(r1)
procedure(foo), pointer :: r1
end function foo
function bar() result(r2)
procedure(baz), pointer :: r2
end function bar
function baz() result(r3)
procedure(bar), pointer :: r3
end function baz
end module m
2013-02-03 Mikael Morin <[email protected]>
PR fortran/54195
* resolve.c (resolve_typebound_procedures): Recurse through
resolve_symbol.
2013-02-03 Mikael Morin <[email protected]>
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;
! { dg-do compile }
!
! PR fortran/54195
! The compiler used to diagnose a duplicate entity in the assignment interface
! because NC was resolved twice.
!
! Contributed by Damian Rouson <[email protected]>
module import_clashes_with_generic
type ,abstract :: foo
contains
procedure :: unary
generic :: operator(-) => unary
end type
abstract interface
integer function bar()
import :: foo
end function
end interface
contains
integer function unary(rhs)
class(foo) ,intent(in) :: rhs
end function
end module
! { dg-do compile }
!
! PR fortran/54195
! The compiler used to diagnose a duplicate entity in the assignment interface
! because NC was resolved twice.
!
! Contributed by Andrew Benson <[email protected]>
module gn
implicit none
type :: nc
contains
procedure :: assign => nca
generic :: assignment(=) => assign
end type
type, extends(nc) :: ncb
contains
procedure , nopass :: tis => bf
end type
contains
subroutine nca(to,from)
class(nc), intent(out) :: to
type(nc), intent(in) :: from
end subroutine
logical function bf()
bf=.false.
end function
end module
