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: 1781060 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: legolas.ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.a=rsa-sha256 header.s=default header.b=bH3G4/91; dkim-atps=neutral Received: from sourceware.org (ip-8-43-85-97.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (P-384) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4QKD4g2KY3z20dR for ; Mon, 15 May 2023 06:05:07 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id B86E6385802F for ; Sun, 14 May 2023 20:05:03 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org B86E6385802F DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1684094703; 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=bH3G4/91IRZ0DPUkUZBb60ThV9sQfTdULB6fUHNeVcsTYmDmPaBdI5rOvFL8mTlmz 6kNGZKA6h/v/513UBJLm9wf7kSrncLYD8m0m7cDFAH2en67PoDnCYFyJ76NUM+eMji vYbTsZCwkypvLAhq3zpqDT0gaJbB45Xa4VR71pG0= 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+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" 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