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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 02c43558aa3e1326abba4faf1c4d0e643838ff30..99063d30ec564978cadd697c331167af176429a8 100644 (file)
--- 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 b63a0c69e6a6e452fd2f52b7a8745dba3e518c98..34b3e9e23726304c93c6f8408d8f82cdf6c5180b 100644 (file)
--- 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 010fa89a8ea4a2afbaa2917ec11d2e7a00d9f235..d657e47ee60ec7bdd6b020c5038b02ffb5e90d0d 100644 (file)
--- 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 (file)
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" } }