Dear All,
Having stated in the PR that I did not have time to fix it, after a
few hours in the workshop doing woodwork I alighted on the obvious and
simple solution :-)
A question for the standard aficianados: Are there other base object
expressions that are legal? Clearly this fix is extendable.
Bootstrapped and regtested on FC9/x86_64 - OK for trunk?
Paul
2012-01-08 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/PR51791
* interface.c (matching_typebound_op): Drill down through
possible parentheses to obtain base expression.
* resolve.c (resolve_ordinary_assign): Extend error message for
polymorphic assignment to advise checking for specific
subroutine.
2012-01-08 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/PR51791
* gfortran.dg/typebound_operator_7.f03: Insert parentheses
around base object in first assignment in main program.
* gfortran.dg/typebound_operator_7.f03: New test.
Index: gcc/testsuite/gfortran.dg/typebound_operator_10.f03
===================================================================
*** gcc/testsuite/gfortran.dg/typebound_operator_10.f03 (revision 0)
--- gcc/testsuite/gfortran.dg/typebound_operator_10.f03 (revision 0)
***************
*** 0 ****
--- 1,29 ----
+ ! { dg-do compile }
+ ! PR51791 and original testcase for PR46328.
+ !
+ ! Contributer by Thomas Koenig <tkoe...@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" } }
Index: gcc/testsuite/gfortran.dg/typebound_operator_7.f03
===================================================================
*** gcc/testsuite/gfortran.dg/typebound_operator_7.f03 (revision 182988)
--- gcc/testsuite/gfortran.dg/typebound_operator_7.f03 (working copy)
*************** program main
*** 90,96 ****
class(i_field) ,allocatable :: u
allocate (u, source = i_field (99))
! 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
--- 90,96 ----
class(i_field) ,allocatable :: u
allocate (u, source = i_field (99))
! 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
Index: gcc/fortran/interface.c
===================================================================
*** gcc/fortran/interface.c (revision 182988)
--- gcc/fortran/interface.c (working copy)
*************** matching_typebound_op (gfc_expr** tb_bas
*** 3168,3173 ****
--- 3168,3177 ----
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)
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 182988)
--- gcc/fortran/resolve.c (working copy)
*************** resolve_ordinary_assign (gfc_code *code,
*** 9208,9215 ****
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);
return false;
}
--- 9208,9216 ----
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 "
! "- check that there is a matching specific subroutine "
! "for '=' operator", &lhs->where);
return false;
}
