re PR fortran/52729 (Symbol has no implicit type in SELECT TYPE block)

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

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

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

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

From-SVN: r186318

4 files changed, 86 insertions, 4 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 02c4355..99063d3 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2012-04-11  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/52729
+	* resolve.c (resolve_symbol): Fix searching for parent NS decl.
+
 2012-04-08  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/52751
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index b63a0c6..34b3e9e 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -12246,7 +12246,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 +12273,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)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 010fa89..d657e47 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2012-04-11  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/52729
+	* gfortran.dg/block_11.f90: New.
+
 2012-04-11  Nick Clifton  <nickc@redhat.com>
 
 	* gcc.dg/stack-usage-1.c (SIZE): Define for the RL78.
@@ -20,7 +25,7 @@
 2012-04-11  Manuel López-Ibáñez  <manu@gcc.gnu.org>
 
 	PR 24985
-        * lib/prune.exp: Add -fno-diagnostics-show-caret.
+	* lib/prune.exp: Add -fno-diagnostics-show-caret.
 
 2012-04-11  Richard Guenther  <rguenther@suse.de>
 
diff --git a/gcc/testsuite/gfortran.dg/block_11.f90 b/gcc/testsuite/gfortran.dg/block_11.f90
new file mode 100644
index 0000000..83c6519
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/block_11.f90
@@ -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" } }