[Patch, Fortran] PR52729 - fix module-proc decl access for BLOCK/SELECT TYPE

[Tobias Burnus <burnus at net-b dot de>]

A rather obvious patch.

The module procedure had the FL_PROCEDURE due its use ("CALL sub" or 
"func()") - but no interface and no type. Thus, there was no attempt to 
search for the symbol in the parent namespace, which causes failures.

Build and tested on x86-84-linux.
OK for the trunk?

Tobias

PS: I lost track. Are there patches which still have to be reviewed?
2012-04-03  Tobias Burnus  <burnus@net-b.de>

	PR fortran/52729
	* resolve.c (resolve_symbol): Fix searching for parent NS decl.

2012-04-03  Tobias Burnus  <burnus@net-b.de>

	PR fortran/52729
	* gfortran.dg/block_11.f90: New.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index b63a0c6..910d322 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -12246,7 +12277,10 @@ resolve_symbol (gfc_symbol *sym)
   symbol_attribute class_attr;
   gfc_array_spec *as;
 
-  if (sym->attr.flavor == FL_UNKNOWN)
+  if (sym->attr.flavor == FL_UNKNOWN
+      || (sym->attr.flavor == FL_PROCEDURE && !sym->attr.intrinsic
+	  && !sym->attr.generic && !sym->attr.external
+	  && sym->attr.if_source == IFSRC_UNKNOWN))
     {
 
     /* If we find that a flavorless symbol is an interface in one of the
@@ -12270,9 +12303,10 @@ resolve_symbol (gfc_symbol *sym)
 
       /* Otherwise give it a flavor according to such attributes as
 	 it has.  */
-      if (sym->attr.external == 0 && sym->attr.intrinsic == 0)
+      if (sym->attr.flavor == FL_UNKNOWN && sym->attr.external == 0
+	  && sym->attr.intrinsic == 0)
 	sym->attr.flavor = FL_VARIABLE;
-      else
+      else if (sym->attr.flavor == FL_UNKNOWN)
 	{
 	  sym->attr.flavor = FL_PROCEDURE;
 	  if (sym->attr.dimension)

--- /dev/null	2012-03-22 21:06:43.387787737 +0100
+++ gcc/gcc/testsuite/gfortran.dg/block_11.f90	2012-04-03 10:52:27.000000000 +0200
@@ -0,0 +1,68 @@
+! { dg-do link }
+!
+! PR fortran/52729
+!
+! Based on a contribution of Andrew Benson
+!
+module testMod
+  type testType
+  end type testType
+contains
+  subroutine testSub()
+    implicit none
+    procedure(double precision ), pointer :: r
+    class    (testType         ), pointer :: testObject
+    double precision                      :: testVal
+
+    ! Failed as testFunc was BT_UNKNOWN
+    select type (testObject)
+    class is (testType)
+       testVal=testFunc()
+       r => testFunc
+    end select
+    return
+  end subroutine testSub
+
+  double precision function testFunc()
+    implicit none
+    return
+  end function testFunc
+end module testMod
+
+module testMod2
+  implicit none
+contains
+  subroutine testSub()
+    procedure(double precision ), pointer :: r
+    double precision                      :: testVal
+    ! Failed as testFunc was BT_UNKNOWN
+    block
+      r => testFunc
+      testVal=testFunc()
+    end block
+  end subroutine testSub
+
+  double precision function testFunc()
+  end function testFunc
+end module testMod2
+
+module m3
+  implicit none
+contains
+  subroutine my_test()
+    procedure(), pointer :: ptr
+    ! Before the fix, one had the link error
+    ! "undefined reference to `sub.1909'"
+    block
+      ptr => sub
+      call sub()
+    end block
+  end subroutine my_test
+  subroutine sub(a)
+    integer, optional :: a
+  end subroutine sub
+end module m3
+
+end
+
+! { dg-final { cleanup-modules "testmod testmod2 m3" } }