re PR fortran/44558 ([OOP] ICE on invalid code: called TBP subroutine as TBP function)

2010-06-17  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/44558
	* resolve.c (resolve_typebound_function,resolve_typebound_subroutine):
	Return directly in case of an error.


2010-06-17  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/44558
	* gfortran.dg/typebound_call_15.f03: New.

From-SVN: r160948

gcc/fortran/ChangeLog

+2010-06-17  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44558
+	* resolve.c (resolve_typebound_function,resolve_typebound_subroutine):
+	Return directly in case of an error.
+
 2010-06-16  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/44549

gcc/fortran/resolve.c

@@ -5498,7 +5498,8 @@ resolve_typebound_function (gfc_expr* e)
 
   /* Treat the call as if it is a typebound procedure, in order to roll
      out the correct name for the specific function.  */
-  resolve_compcall (e, &name);
+  if (resolve_compcall (e, &name) == FAILURE)
+    return FAILURE;
   ts = e->ts;
 
   /* Then convert the expression to a procedure pointer component call.  */
@@ -5571,7 +5572,8 @@ resolve_typebound_subroutine (gfc_code *code)
   if (code->expr1->value.compcall.tbp->is_generic)
     genname = code->expr1->value.compcall.name;
 
-  resolve_typebound_call (code, &name);
+  if (resolve_typebound_call (code, &name) == FAILURE)
+    return FAILURE;
   ts = code->expr1->ts;
 
   /* Then convert the expression to a procedure pointer component call.  */

gcc/testsuite/ChangeLog

+2010-06-17  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44558
+	* gfortran.dg/typebound_call_15.f03: New.
+
 2010-06-17  Manuel López-Ibáñez  <manu@gcc.gnu.org>
 
 	PR c++/44486

gcc/testsuite/gfortran.dg/typebound_call_15.f03

+! { dg-do compile }
+!
+! PR 44558: [OOP] ICE on invalid code: called TBP subroutine as TBP function
+!
+! Contributed by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de>
+
+module ice5
+  type::a_type
+   contains  
+     procedure::a_subroutine_1
+     procedure::a_subroutine_2
+  end type a_type
+contains
+  real function a_subroutine_1(this)
+    class(a_type)::this
+    real::res
+    res=this%a_subroutine_2()     ! { dg-error "should be a FUNCTION" }
+  end function
+  subroutine a_subroutine_2(this)
+    class(a_type)::this
+    call this%a_subroutine_1()    ! { dg-error "should be a SUBROUTINE" }
+  end subroutine
+end module ice5
+ 
+! { dg-final { cleanup-modules "ice5" } }