2009-11-15 Janus Weil <janus@gcc.gnu.org>

	PR fortran/42048
	* match.c (gfc_match_call): If we're inside a function with derived
	type return value, allow calling a TBP of the result variable.

2009-11-15  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42048
	* gfortran.dg/typebound_call_11.f03: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@154190 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6f1aadd..19e4a29 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2009-11-15  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/42048
+       * match.c (gfc_match_call): If we're inside a function with derived
+       type return value, allow calling a TBP of the result variable.
+

 2009-11-12  Tobias Burnus  <burnus@net-b.de>
 
        * intrinsic.texi (XOR): Refer also to .NEQV.
 2009-11-12  Tobias Burnus  <burnus@net-b.de>
 
        * intrinsic.texi (XOR): Refer also to .NEQV.

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 24e292b..13f68ab 100644 (file)
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -2975,7 +2975,7 @@ gfc_match_call (void)
 
   /* If this is a variable of derived-type, it probably starts a type-bound
      procedure call.  */
 
   /* If this is a variable of derived-type, it probably starts a type-bound
      procedure call.  */

-  if (sym->attr.flavor != FL_PROCEDURE
+  if ((sym->attr.flavor != FL_PROCEDURE || sym == gfc_current_ns->proc_name)

       && (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS))
     return match_typebound_call (st);
 
       && (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS))
     return match_typebound_call (st);
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index dacc1c1..3c5f5f0 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2009-11-15  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/42048
+       * gfortran.dg/typebound_call_11.f03: New test.
+

 2009-11-15  Hans-Peter Nilsson  <hp@axis.com>
 
        * gcc.dg/lto/lto.exp: For non-lto, bail out before calling
 2009-11-15  Hans-Peter Nilsson  <hp@axis.com>
 
        * gcc.dg/lto/lto.exp: For non-lto, bail out before calling

diff --git a/gcc/testsuite/gfortran.dg/typebound_call_11.f03 b/gcc/testsuite/gfortran.dg/typebound_call_11.f03
new file mode 100644 (file)
index 0000000..14f3232
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_11.f03
@@ -0,0 +1,40 @@
+! { dg-do compile }
+!
+! PR 42048: [F03] Erroneous syntax error message on TBP call
+!
+! Contributed by Damian Rouson <rouson@sandia.gov>
+
+module grid_module
+ implicit none
+ type grid
+ contains
+   procedure :: new_grid
+ end type
+contains
+ subroutine new_grid(this)
+   class(grid) :: this
+ end subroutine
+end module
+
+module field_module
+ use grid_module
+ implicit none
+
+ type field
+   type(grid) :: mesh
+ end type
+
+contains
+
+ type(field) function new_field()
+  call new_field%mesh%new_grid()
+ end function
+
+ function new_field2() result(new)
+  type(field) :: new
+  call new%mesh%new_grid()
+ end function
+
+end module
+
+! { dg-final { cleanup-modules "grid_module field_module" } }