re PR fortran/51791 ([OOP] Failure to resolve typebound function call with base…

re PR fortran/51791 ([OOP] Failure to resolve typebound function call with base object in parentheses.)

2012-01-09  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/51791
	* interface.c (matching_typebound_op): Drill down through
	possible parentheses to obtain base expression. Do not test for
	'class_ok' but, instead for the class structure components.
	* resolve.c (resolve_ordinary_assign): Extend error message for
	polymorphic assignment to advise checking for specific
	subroutine.

	PR fortran/51792
	* resolve.c (resolve_typebound_function): Restore 'static' to
	declaration.

2012-01-09  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/51791
	* gfortran.dg/typebound_operator_7.f03: Insert parentheses
	around base object in first assignment in main program.
	* gfortran.dg/typebound_operator_10.f03: New test.

From-SVN: r183032

gcc/fortran/ChangeLog

+2012-01-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/51791
+	* interface.c (matching_typebound_op): Drill down through
+	possible parentheses to obtain base expression. Do not test for
+	'class_ok' but, instead for the class structure components.
+	* resolve.c (resolve_ordinary_assign): Extend error message for
+	polymorphic assignment to advise checking for specific
+	subroutine.
+
+	PR fortran/51792
+	* resolve.c (resolve_typebound_function): Restore 'static' to
+	declaration.
+
 2012-01-09  Mikael Morin  <mikael@gcc.gnu.org>
 
 	PR fortran/51758

gcc/fortran/interface.c

@@ -3168,9 +3168,13 @@ matching_typebound_op (gfc_expr** tb_base,
 	gfc_symbol* derived;
 	gfc_try result;
 
+	while (base->expr->expr_type == EXPR_OP
+	       && base->expr->value.op.op == INTRINSIC_PARENTHESES)
+	  base->expr = base->expr->value.op.op1;
+
 	if (base->expr->ts.type == BT_CLASS)
 	  {
-	    if (!gfc_expr_attr (base->expr).class_ok)
+	    if (CLASS_DATA (base->expr) == NULL)
 	      continue;
 	    derived = CLASS_DATA (base->expr)->ts.u.derived;
 	  }

gcc/fortran/resolve.c

@@ -5887,7 +5887,7 @@ resolve_compcall (gfc_expr* e, const char **name)
 /* Resolve a typebound function, or 'method'. First separate all
    the non-CLASS references by calling resolve_compcall directly.  */
 
-gfc_try
+static gfc_try
 resolve_typebound_function (gfc_expr* e)
 {
   gfc_symbol *declared;
@@ -9208,8 +9208,9 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
      and coindexed; cf. F2008, 7.2.1.2 and PR 43366.  */
   if (lhs->ts.type == BT_CLASS)
     {
-      gfc_error ("Variable must not be polymorphic in assignment at %L",
-		 &lhs->where);
+      gfc_error ("Variable must not be polymorphic in assignment at %L "
+		 "- check that there is a matching specific subroutine "
+		 "for '=' operator", &lhs->where);
       return false;
     }
 

gcc/testsuite/ChangeLog

+2012-01-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/51791
+	* gfortran.dg/typebound_operator_7.f03: Insert parentheses
+	around base object in first assignment in main program.
+	* gfortran.dg/typebound_operator_10.f03: New test.
+
 2012-01-09  Martin Jambor  <mjambor@suse.cz>
 
         PR tree-optimization/51759

gcc/testsuite/gfortran.dg/typebound_operator_10.f03

+! { dg-do compile }
+! PR51791 and original testcase for PR46328.
+!
+! Contributer by Thomas Koenig  <tkoenig@gcc.gnu.org>
+!
+module field_module
+  implicit none
+  type ,abstract :: field
+  contains
+    procedure(field_op_real) ,deferred :: multiply_real
+    generic :: operator(*) => multiply_real
+  end type
+  abstract interface
+    function field_op_real(lhs,rhs)
+      import :: field
+      class(field) ,intent(in)  :: lhs
+      real ,intent(in) :: rhs
+      class(field) ,allocatable :: field_op_real
+    end function
+  end interface
+end module
+
+program main
+  use field_module
+  implicit none
+  class(field) ,pointer :: u
+  u = (u)*2. ! { dg-error "check that there is a matching specific" }
+end program
+! { dg-final { cleanup-modules "field_module" } }

gcc/testsuite/gfortran.dg/typebound_operator_7.f03

@@ -90,7 +90,7 @@ program main
   class(i_field) ,allocatable :: u
   allocate (u, source = i_field (99))
 
-  u = u*2.
+  u = (u)*2.
   u = (u*2.0*4.0) + u*4.0
   u = u%multiply_real (2.0)*4.0
   u = i_multiply_real (u, 2.0) * 4.0