From patchwork Sun May 14 20:04:25 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 93755 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:b0ea:0:b0:3b6:4342:cba0 with SMTP id b10csp6480686vqo; Sun, 14 May 2023 13:05:37 -0700 (PDT) X-Google-Smtp-Source: ACHHUZ6TG3ZTdiUF0HGbIRogUvxXWndHXGLfdgYniTE+WFnFxttaO0x7Jqsglgjam+5049FnWdGD X-Received: by 2002:a05:6402:64d:b0:504:b64d:759c with SMTP id u13-20020a056402064d00b00504b64d759cmr21067571edx.35.1684094737478; Sun, 14 May 2023 13:05:37 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1684094737; cv=none; d=google.com; s=arc-20160816; b=xQ9v6Di+hU+MH8mo1VJzHdyWLRnd9lgEcwjKdaNOScr4icmjtS6deRPftghhOJHZ2U DUIBRhHfesypWsm9vgdJy3gNW9PIC9E3uTZnJqCieqBVeUEQROJZm+irlI6CK0AMacKR ZLyLozfiKz9pFQTuegonYwEE4owTujilhnCFnhsKDhcLNOT+pWUD9Ng73bbiUvCZGwpZ cHd1kUvj4BLjDVRwapykb7JbILZW2ZftPdXQLQT7Rd7zCBpmf7Ztv3lktbJJEBPitq7I 9v5Z67yXbar6Zyf0/AtAP4nIzmdlHLlO37+oFJQqEehy4j5mygaY6PfUqCBOa7uD4RBx gTSw== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:reply-to:from:list-subscribe:list-help:list-post :list-archive:list-unsubscribe:list-id:precedence:ui-outboundreport :sensitivity:importance:date:subject:to:message-id:mime-version :dmarc-filter:delivered-to:dkim-signature:dkim-filter; bh=TFG3v5+tg5cgc/GgIeL+Y15GQVXoCr1UjLv5BG9Idj8=; b=Px2fEScpfsLX0ehVDPUNeJNhP2LbRo8n1GU1drdpcMudLbnnto3HotyBTGsECMoyHD isXEpQAd8VuiPmt1xlY9aVwfNdm2JgFE0f1EtcX6jsPaS4V42trYNs3s7IhPYemukL2B UCWGGT9ob8M/UjMZIiAHwUdNVsUNw7yB+xvMiT7NGD701PE7L2JdUQs4IUZozdlWEPJ1 oHw0uBCJRbRW441EN1of0kGQ3sZKDzIBK3uy0Kq6zQKmkni4b164zUzYAfD5HD7hlSIc vgIlQk3C40TqpwOHxjME5BUllpU0ancBBuihfHkxf+FK6M8U6s80qilT5Sx6C+x1KRvl RCNA== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=vbba9UCt; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from sourceware.org (server2.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id r18-20020aa7d152000000b00506a2e77706si10047280edo.498.2023.05.14.13.05.37 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sun, 14 May 2023 13:05:37 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) client-ip=8.43.85.97; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=vbba9UCt; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 6484C38555A8 for ; Sun, 14 May 2023 20:05:28 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 6484C38555A8 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1684094728; bh=TFG3v5+tg5cgc/GgIeL+Y15GQVXoCr1UjLv5BG9Idj8=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=vbba9UCt19v19XxY/EnRSSB1pnSZ2nmBBrAcWweacQcNmM0+M6YtYFqMw21kFhD9B vQU1q2D4806GKoEArnYShUZOmk+AvI+Bf3+g4eK4BR2zvYXN4KAZyl+qazr2mqD0OC gdTb/BOMV5+baStYCrBTt6Abrt8MWA4pw/MM82uc= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mout.gmx.net (mout.gmx.net [212.227.15.19]) by sourceware.org (Postfix) with ESMTPS id ABC8E3858D37; Sun, 14 May 2023 20:04:26 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org ABC8E3858D37 X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [79.251.6.104] ([79.251.6.104]) by web-mail.gmx.net (3c-app-gmx-bs49.server.lan [172.19.170.102]) (via HTTP); Sun, 14 May 2023 22:04:25 +0200 MIME-Version: 1.0 Message-ID: To: fortran , gcc-patches Subject: [PATCH] Fortran: CLASS pointer function result in variable definition context [PR109846] Date: Sun, 14 May 2023 22:04:25 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:+IFKuk3x7+jbtDhjcqq+O+5EL9EP1pFcLuA8whEY32LtCs6Z5eKQoWo0qr6+Lm4tt/vAs H5v44wsolBAh0of5+Zn5TzuGRki1/gNUNapQrZVhoJ285JdmvB8JeyGoMg/D9kKo3m83+YWpvyG2 LDqJSYwViW84bMKRi0LbKb4jgVKcJXHVPq4pfR/WcV7RMH/GzoyvLT9EDH8XuuUYGbXLTuCCixAw iGD1HXBrtPzNwjbesWJciicBeagUQrJ4QJjqTVv8uq942J+hUrr4VbIz+j1Yi8JlfQVEYlWhsI3w CU= UI-OutboundReport: notjunk:1;M01:P0:NZBbSeXQKa8=;Ear7mCGCUTXWASQUfEGrB+1avVE X7TURZInGsBOCRTtspWqDBq13g9QRn7sb9V9V/A1335gbv+J+g/jmFjgEHBSYwx683Pxm+btW UuRx86lpXD/99AvLsPT/CS2f7WuU//BlM9+qY5sP/4UsC+A2I2nZQnTlbhxcwRnBFVlMRzPbn CtEzaogaxO8wBeX+VY791d8yCrD6mSLKmqOW0xS/31TTG7BJFb5+WJ7BdRBecPK46PRdULUXK wtMPjk4AyNswwZotOh/HKVGiXHlxXUveXhdLB6bCubaCoLsHIRfR7EAjG8wW0hpLpEB2dA31u RjQWE6diY+5tveb3laGS9EyGSdCCWikvDFt0zr82Xe0et48PhIVI6YYi868kynrqcd8FtJ7PJ IzQCjAiwRcrwEr4Z+U8ER1CTA82Udai6JjglX3JrsqCQVtljHfVN2jKWAg9ly/QaeLBuLf1IS a44p4pTe8u3V+gyirswmz55PZIWlH/2Ev2bUsLghc+a05Uopaizs6J/SQPRbDe1vYBJ7gI/kj r6WUbVONf1uYY8+OJp6GKnj+VVlml/cGgqCVU5TmTsdtF8OoGpwqhUvPLz7RzHl5UREKpRRij f2I6ZcGADUmfflbsEoMkfHhDVKV9HDOShfpa9ml6R7t71MiEMQyCeEEP3Ygx7M62Q4/jTwkP8 JeJvI6nxEcwy8fKoCDStKzfawUnw13D0Nk9KQPPVbDmcNIOHiHiupczpJoXp1oH7aHH71NbhM WsSjg2/ykcoGmPjEIciuVyp5IzeSeQnHEpyZZ0JCaaSG0r5iwoGXFlP4/AbD+6/Gbpi7aEa0f 7EbgX3WilwRi7VQgLH3VCnCg== X-Spam-Status: No, score=-12.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Harald Anlauf via Gcc-patches From: Harald Anlauf Reply-To: Harald Anlauf Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: =?utf-8?q?INBOX?= X-GMAIL-THRID: =?utf-8?q?1765901323578216982?= X-GMAIL-MSGID: =?utf-8?q?1765901323578216982?= Dear all, Fortran allows functions in variable definition contexts when the result variable is a pointer. We already handle this for the non-CLASS case (in 11+), but the logic that checks the pointer attribute was looking in the wrong place for the CLASS case. Once found, the fix is simple and obvious, see attached patch. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald From 6406f19855a3b664597d75369f0935d3d31384dc Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Sun, 14 May 2023 21:53:51 +0200 Subject: [PATCH] Fortran: CLASS pointer function result in variable definition context [PR109846] gcc/fortran/ChangeLog: PR fortran/109846 * expr.cc (gfc_check_vardef_context): Check appropriate pointer attribute for CLASS vs. non-CLASS function result in variable definition context. gcc/testsuite/ChangeLog: PR fortran/109846 * gfortran.dg/ptr-func-5.f90: New test. --- gcc/fortran/expr.cc | 2 +- gcc/testsuite/gfortran.dg/ptr-func-5.f90 | 39 ++++++++++++++++++++++++ 2 files changed, 40 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/ptr-func-5.f90 diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index d91722e6ac6..09a16c9b367 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -6256,7 +6256,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, && !(sym->attr.flavor == FL_PROCEDURE && sym == sym->result) && !(sym->attr.flavor == FL_PROCEDURE && sym->attr.proc_pointer) && !(sym->attr.flavor == FL_PROCEDURE - && sym->attr.function && sym->attr.pointer)) + && sym->attr.function && attr.pointer)) { if (context) gfc_error ("%qs in variable definition context (%s) at %L is not" diff --git a/gcc/testsuite/gfortran.dg/ptr-func-5.f90 b/gcc/testsuite/gfortran.dg/ptr-func-5.f90 new file mode 100644 index 00000000000..05fd56703ca --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ptr-func-5.f90 @@ -0,0 +1,39 @@ +! { dg-do compile } +! PR fortran/109846 +! CLASS pointer function result in variable definition context + +module foo + implicit none + type :: parameter_list + contains + procedure :: sublist, sublist_nores + end type +contains + function sublist (this) result (slist) + class(parameter_list), intent(inout) :: this + class(parameter_list), pointer :: slist + allocate (slist) + end function + function sublist_nores (this) + class(parameter_list), intent(inout) :: this + class(parameter_list), pointer :: sublist_nores + allocate (sublist_nores) + end function +end module + +program example + use foo + implicit none + type(parameter_list) :: plist + call sub1 (plist%sublist()) + call sub1 (plist%sublist_nores()) + call sub2 (plist%sublist()) + call sub2 (plist%sublist_nores()) +contains + subroutine sub1 (plist) + type(parameter_list), intent(inout) :: plist + end subroutine + subroutine sub2 (plist) + type(parameter_list) :: plist + end subroutine +end program -- 2.35.3