From patchwork Fri Nov 18 17:00:17 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andre Vehreschild X-Patchwork-Id: 83011 Delivered-To: patch@linaro.org Received: by 10.182.1.168 with SMTP id 8csp191405obn; Fri, 18 Nov 2016 09:00:56 -0800 (PST) X-Received: by 10.37.58.4 with SMTP id h4mr385491yba.82.1479488455934; Fri, 18 Nov 2016 09:00:55 -0800 (PST) Return-Path: Received: from sourceware.org (server1.sourceware.org. [209.132.180.131]) by mx.google.com with ESMTPS id x203si1890917ywb.209.2016.11.18.09.00.54 for (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Fri, 18 Nov 2016 09:00:55 -0800 (PST) Received-SPF: pass (google.com: domain of gcc-patches-return-441978-patch=linaro.org@gcc.gnu.org designates 209.132.180.131 as permitted sender) client-ip=209.132.180.131; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org; spf=pass (google.com: domain of gcc-patches-return-441978-patch=linaro.org@gcc.gnu.org designates 209.132.180.131 as permitted sender) smtp.mailfrom=gcc-patches-return-441978-patch=linaro.org@gcc.gnu.org DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:subject:message-id:mime-version:content-type; q=dns; s= default; b=LDAIFon0uB7VTuXnwZvrh/LI1LPbaDHuJRhSPVa/BudynR4vc3+Pg 0wUHtr+WJw8g4AhV2BPceXyubNOSgURCKAwFYGZAc6j2sY6r+xm6lehFQF9Tepqn LwagCBi2CAwceWhzInufOyPfO7heAFr4SP5E98yx+B7Lyklg9tWFUs= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:subject:message-id:mime-version:content-type; s= default; bh=7knDc5dPydIYhn/X5NbortJ1HUA=; b=D/pxnchClhLgnMkj5ImH tLovKDNqGTEJZYZIUVUkIUBKbsaD3gcnGH9u0Dj/Xou0Y6KFQtcYhJobGvqseCIR 6CokBUPZFNtS4iXZilinoj5kORAYR+jEwG5I+2B1IPRTMf5WBPnESHMTWKrTmghq u/FFjqdKcP1HG7JhMtu/qpM= Received: (qmail 117097 invoked by alias); 18 Nov 2016 17:00:35 -0000 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 Received: (qmail 117017 invoked by uid 89); 18 Nov 2016 17:00:31 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-2.5 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, RCVD_IN_DNSWL_LOW, SPF_PASS autolearn=ham version=3.3.2 spammy=bootstraped, Contributed, applicable X-Spam-User: qpsmtpd, 2 recipients X-HELO: mout.gmx.net Received: from mout.gmx.net (HELO mout.gmx.net) (212.227.17.22) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Fri, 18 Nov 2016 17:00:21 +0000 Received: from vepi2 ([92.76.205.227]) by mail.gmx.com (mrgmx103 [212.227.17.168]) with ESMTPSA (Nemesis) id 0LZzY9-1cUifX0pen-00lm7e; Fri, 18 Nov 2016 18:00:18 +0100 Date: Fri, 18 Nov 2016 18:00:17 +0100 From: Andre Vehreschild To: GCC-Patches-ML , GCC-Fortran-ML Subject: [PATCH, Fortran, pr78395, v1] [OOP] error on polymorphic assignment Message-ID: <20161118180017.476fcdaf@vepi2> MIME-Version: 1.0 X-UI-Out-Filterresults: notjunk:1; V01:K0:aG5YTeSns1g=:zMd0Avlded2K0oVqEQS+CD diZaemVz7g/pC1fSLcUHquwF1j2k8lqrNPhdXnSyhgL0fH286bCP2Ja4E76B6jMEHrHknYj6K VzosckdbTmpySmfn81rpRKfl982O/HA4nAT6hZGb51VPo+ojcxmqKwPpgapDN7LfPojw/xJRD vxQ3QWvgwSomcTZudd1Yv61qyH0Bf7VD1nYgIEam900/LRMm2AWlJ2vWxIRXpFlfEjDJw9AT6 vV+nbDCp9jxmFSrjriwrCe98m+wR6GJmkIKfdYPQdgGUDtmPlxy16FKm1NyOfgOAVD3JAEFzc 14HKYHA75rJIAVrYQxXpnSnv6djsV3d2YluDAGvX1Mwxv9SStEuhSWB05ovXfz8PTI/2joaCk MtHtXquwOpAf4iSi3vx+fONe7V0rcsZdZHfJWu2CFEoo2mAyx1CGizCYcPYQkhJ3dSHQ2z23H zSYADAj3mEDM39FcsxOdHLVIOUT3Oknz3pK/q/rpfGkmwL0iRWv1ggRM6xaVE3JEnvnUHILwm IxO3StCs8Q7OlhgLJ+3jUniM9kzisxnyUSbMtTbEX+ACbLltaDiiNBc9rpXFbkJxkqMWDETaw QRvqOfCHlcsV5Ur4aL1MyQg3w0l7PMUgrFwOvTD2oLZ8VFAsipIExOd9Jdsn/kJj9b4LE5K2p YJKkGmS/qxXdOa1yyPOj7pOUCgFKOnklH6hx5hM0Ogudee/qwikHRMQWt+zqNPYX4DJzyGDHm NndUH8j/2oU6gcjyBzGK10OcaSXkRsCTNHn2M27BMNMWlPSmQMvbk/3EaEY= Hi all, attached patch fixes the issue which was given by nesting calls to typebound procedures. The expression of the inner typebound procedure call was resolved correctly, but in the case of it's having a class type the ref-list was discarded. Leaving the list of references untouched, resolves the wrong error-message and generates correct code. When checking the shortened example in comment #3 one gets a segfault, because v6 is not allocated explicitly. The initial example made sure, that v6 was allocated. Reading through the standard, I did not find, whether the auto-allocation is applicable here. I therefore have extended the testcase by an allocate(v6). Dominique pointed out, that there are already some prs for adding an on-demand -fcheck=something runtime check for not allocated objects. But that does not solve the question, whether v6 should be auto-allocated when assigned by a typebound-procedure (ifort and cray need v6 allocated do, i.e., they don't auto-allocate). Btw, when using the in gcc-7 available polymorphic assign, then v6 is actually auto-allocated and the program runs fine. So what are your opinions on the auto-allocation issue? This patch fixes the wrong error messages in both gcc-7 and gcc-6. Bootstraped and regtested on x86_64-linux/F23 for gcc-7 and -6. Ok for trunk and gcc-6? Regards, Andre -- Andre Vehreschild * Email: vehre ad gmx dot de gcc/testsuite/ChangeLog: 2016-11-18 Andre Vehreschild PR fortran/78395 * gfortran.dg/typebound_operator_21.f03: New test. gcc/fortran/ChangeLog: 2016-11-18 Andre Vehreschild PR fortran/78395 * resolve.c (resolve_typebound_function): Prevent stripping of refs, when the base-expression is a class' typed one. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 825bb12..589a673 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -6140,7 +6140,7 @@ resolve_typebound_function (gfc_expr* e) gfc_free_ref_list (class_ref->next); class_ref->next = NULL; } - else if (e->ref && !class_ref) + else if (e->ref && !class_ref && expr->ts.type != BT_CLASS) { gfc_free_ref_list (e->ref); e->ref = NULL; diff --git a/gcc/testsuite/gfortran.dg/typebound_operator_21.f03 b/gcc/testsuite/gfortran.dg/typebound_operator_21.f03 new file mode 100644 index 0000000..ea374a1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_operator_21.f03 @@ -0,0 +1,78 @@ +! { dg-do run } +! +! Test that pr78395 is fixed. +! Contributed by Chris and Janus Weil + +module types_mod + implicit none + + type, public :: t1 + integer :: a + contains + procedure :: get_t2 + end type + + type, public :: t2 + integer :: b + contains + procedure, pass(rhs) :: mul2 + procedure :: assign + generic :: operator(*) => mul2 + generic :: assignment(=) => assign + end type + +contains + + function get_t2(this) + class(t1), intent(in) :: this + class(t2), allocatable :: get_t2 + type(t2), allocatable :: local + allocate(local) + local%b = this%a + call move_alloc(local, get_t2) + end function + + function mul2(lhs, rhs) + class(t2), intent(in) :: rhs + integer, intent(in) :: lhs + class(t2), allocatable :: mul2 + type(t2), allocatable :: local + allocate(local) + local%b = rhs%b*lhs + call move_alloc(local, mul2) + end function + + subroutine assign(this, rhs) + class(t2), intent(out) :: this + class(t2), intent(in) :: rhs + select type(rhs) + type is(t2) + this%b = rhs%b + class default + error stop + end select + end subroutine + +end module + + +program minimal + use types_mod + implicit none + + class(t1), allocatable :: v4 + class(t2), allocatable :: v6 + + allocate(v4, source=t1(4)) + allocate(v6) + v6 = 3 * v4%get_t2() + + select type (v6) + type is (t2) + if (v6%b /= 12) error stop + class default + error stop + end select + deallocate(v4, v6) +end +