From patchwork Sun Jan 8 16:36:09 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Paul Richard Thomas X-Patchwork-Id: 134917 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id EF14BB6F65 for ; Mon, 9 Jan 2012 03:36:52 +1100 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1326645413; h=Comment: DomainKey-Signature:Received:Received:Received:Received: MIME-Version:Received:Received:Date:Message-ID:Subject:From:To: Content-Type:Mailing-List:Precedence:List-Id:List-Unsubscribe: List-Archive:List-Post:List-Help:Sender:Delivered-To; bh=1+lak+3 lxCn6g13Upt1l8tcY38k=; b=QPsf7I9iabzDGMlnA49x/qvtL4zLirWivzni/IT ieueIW1nw3lWcDfH71xF/gcxeX9W7yQIYegBOXbsxTitYjvjxukOLjdKrsEz03xD uxJ6sg9xBfW4xE4JT8pPlZk1oSqtunU4dz+J7Cs3YXI0odeHRqMy4hc1LmjoaBZh c0qU= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:MIME-Version:Received:Received:Date:Message-ID:Subject:From:To:Content-Type:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=CUS7KwFAGLLVCMP3GNcCGGPOIQ1t4/2YUkFRN82woFT0OEcwSIYTtTS0qPP0BW amcDhU+pOJ3x7Lp3Piy3h6QKB9jIkX8lvQbOyIg+Vlr6n+v2/hUszZAvMW8lUY7a GcVOGdCc6tMDQpWp7f6+C77snjTEOvt1IO+gpptBc1wsM=; Received: (qmail 18323 invoked by alias); 8 Jan 2012 16:36:31 -0000 Received: (qmail 17796 invoked by uid 22791); 8 Jan 2012 16:36:26 -0000 X-SWARE-Spam-Status: No, hits=0.4 required=5.0 tests=AWL, BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, FREEMAIL_FROM, KAM_STOCKTIP, RCVD_IN_DNSWL_LOW X-Spam-Check-By: sourceware.org Received: from mail-ee0-f47.google.com (HELO mail-ee0-f47.google.com) (74.125.83.47) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sun, 08 Jan 2012 16:36:11 +0000 Received: by eeit10 with SMTP id t10so1762895eei.20 for ; Sun, 08 Jan 2012 08:36:09 -0800 (PST) MIME-Version: 1.0 Received: by 10.14.99.197 with SMTP id x45mr5002254eef.114.1326040569486; Sun, 08 Jan 2012 08:36:09 -0800 (PST) Received: by 10.14.100.5 with HTTP; Sun, 8 Jan 2012 08:36:09 -0800 (PST) Date: Sun, 8 Jan 2012 17:36:09 +0100 Message-ID: Subject: [Patch, fortran] PR51791 - [OOP] Failure to resolve typebound function call with base object in parentheses From: Paul Richard Thomas To: fortran@gcc.gnu.org, gcc-patches Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org 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 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 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 + ! + 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; }