From 60fa39313ecb5f48392bf092c34b1a6a7a64f587 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 11 Apr 2012 15:08:32 +0200 Subject: [PATCH] re PR fortran/52729 (Symbol has no implicit type in SELECT TYPE block) 2012-04-11 Tobias Burnus PR fortran/52729 * resolve.c (resolve_symbol): Fix searching for parent NS decl. 2012-04-11 Tobias Burnus PR fortran/52729 * gfortran.dg/block_11.f90: New. From-SVN: r186318 --- gcc/fortran/ChangeLog | 5 ++ gcc/fortran/resolve.c | 10 ++-- gcc/testsuite/ChangeLog | 7 ++- gcc/testsuite/gfortran.dg/block_11.f90 | 68 ++++++++++++++++++++++++++ 4 files changed, 86 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/block_11.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 02c43558aa3..99063d30ec5 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2012-04-11 Tobias Burnus + + PR fortran/52729 + * resolve.c (resolve_symbol): Fix searching for parent NS decl. + 2012-04-08 Tobias Burnus PR fortran/52751 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index b63a0c69e6a..34b3e9e2372 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 010fa89a8ea..d657e47ee60 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2012-04-11 Tobias Burnus + + PR fortran/52729 + * gfortran.dg/block_11.f90: New. + 2012-04-11 Nick Clifton * gcc.dg/stack-usage-1.c (SIZE): Define for the RL78. @@ -20,7 +25,7 @@ 2012-04-11 Manuel López-Ibáñez PR 24985 - * lib/prune.exp: Add -fno-diagnostics-show-caret. + * lib/prune.exp: Add -fno-diagnostics-show-caret. 2012-04-11 Richard Guenther diff --git a/gcc/testsuite/gfortran.dg/block_11.f90 b/gcc/testsuite/gfortran.dg/block_11.f90 new file mode 100644 index 00000000000..83c6519d970 --- /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" } } -- 2.30.2