From patchwork Thu Jan 25 21:26:45 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 192310 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a05:7300:e09d:b0:103:945f:af90 with SMTP id gm29csp264521dyb; Thu, 25 Jan 2024 13:27:35 -0800 (PST) X-Google-Smtp-Source: AGHT+IGYzg519cd0FHnIGGNc4/AXVRX5jG3w5UL/bhuRdQP5siajepFk/Ywbf2UtC9o+p6OiHFFG X-Received: by 2002:ad4:5f8d:0:b0:67f:3991:ef38 with SMTP id jp13-20020ad45f8d000000b0067f3991ef38mr286951qvb.122.1706218055691; Thu, 25 Jan 2024 13:27:35 -0800 (PST) ARC-Seal: i=2; a=rsa-sha256; t=1706218055; cv=pass; d=google.com; s=arc-20160816; b=U2OKXNcPEU69LrcZ/tPiwAWosd5wB+HGDO/uctAWiX1+YPympS4MBmVG/fXaQYafds pJwzK6RbB3rgBBNJPqPGVqKG+plzviehk7DhYKge7vYFkDlKvn02ib7ZnvO8DCoMyvIr rsJxFG82nHbS/2AwkIqntpfuMtCWEVap62kAGJLqwRKo8lt32HQj0tG0kz64QrrH+4Qq KFBwyM2+SHpClxq4CU2g1ULTcU8OPI/o83PlIi7bpwWiRAxHwww2tdKNiSlr7uLZ7Ns4 AEzHwXb1hkDczK2B9wttf1pEARicgGQVofcw3wKEIOXPClBOwe6q5rAHJI1tl6hPKXR2 Nh0A== ARC-Message-Signature: i=2; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=errors-to:list-subscribe:list-help:list-post:list-archive :list-unsubscribe:list-id:precedence:ui-outboundreport:sensitivity :importance:date:subject:to:from:message-id:mime-version :dkim-signature:arc-filter:dmarc-filter:delivered-to; bh=1gGs0LenfmEyv/LGYNFDOAcKo7y2/hkxYzJERGTY6mQ=; fh=+IEfvAe+9BRgPHWhQEl2uIBTtAiiGDh1ExRZeB5JJoc=; b=VYOGlVOpDsVScnp2bvZ1y8Nmm48XllQ3dgnMy/fk/C6BmBe3/y2TJh7rTd6TT7UYGC 40qYnJbAfGgnDXirQ7MZIiagnG9Blqob6MP0w1QemjYt2L4o5kdBIWZFRp0rLqwudnsG tvfoomysifafMHjMIp9lweg2Xy5YY80B+51yt9s0P/xCH5oLPfth8U6ci8HcDtpKhfRB su334z7CFw11QSce2oJPV2tjGjjLLSMWGIGuW4zSR1fTbRsvbWOie1V6mYuDRbs5MoO3 81qCV2R2SuIWeJabk+OlI4/aBq9taXQ1Qo1evpel5siNayvs/TrmiF7kHEhsj3XMzq15 WuAA== ARC-Authentication-Results: i=2; mx.google.com; dkim=pass header.i=@gmx.de header.s=s31663417 header.b=fFnGOG1d; arc=pass (i=1); 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=QUARANTINE sp=QUARANTINE dis=NONE) header.from=gmx.de Received: from server2.sourceware.org (server2.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id a21-20020a0ca995000000b0068196a55b2csi12686440qvb.132.2024.01.25.13.27.35 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 25 Jan 2024 13:27:35 -0800 (PST) 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=@gmx.de header.s=s31663417 header.b=fFnGOG1d; arc=pass (i=1); 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=QUARANTINE sp=QUARANTINE dis=NONE) header.from=gmx.de Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 450EC3858436 for ; Thu, 25 Jan 2024 21:27:35 +0000 (GMT) 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 2669B3858D28; Thu, 25 Jan 2024 21:26:47 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 2669B3858D28 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 2669B3858D28 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=212.227.15.19 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1706218009; cv=none; b=fIIuDEl+4ODbKQ4RNUimFPYdPsgTIzSINyh8wTY/tv7lT+hGsd8emrYTUHqzw/7PtzRFjoRK7K/8nZmh0SrooTDa5+oiF++BSEUm2RbtNWPHlCSzVKsOfBJFR8aHbIuLDn1AYaJgbfn3DAJbGGXI0Tc9wEY8KaoGRHRyNgqtevg= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1706218009; c=relaxed/simple; bh=xD3HHf84sA4LRTHgc7koIAliFmu4LPtakvcmhhTZDY0=; h=DKIM-Signature:MIME-Version:Message-ID:From:To:Subject:Date; b=Hzg8P7Ubj8zC+AKc15QS112IZFFcYknCyQv1k3ubkPHElzby8XJXFq32xBzgow4anrJ8Hi/7dIrarLkYSSvL9nRzlCuQn753hf6JoBYxVCvAP0vETN+y8XG/M5rIRWFSHdRG/mIVlTYsKrpM2qO3XPYUs98ImUCSLlacXO/nCbQ= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.de; s=s31663417; t=1706218005; x=1706822805; i=anlauf@gmx.de; bh=xD3HHf84sA4LRTHgc7koIAliFmu4LPtakvcmhhTZDY0=; h=X-UI-Sender-Class:From:To:Subject:Date; b=fFnGOG1dKpBhh3gRyTplCWG/U1kcyz9CvnRKPI0gBpvDmw6oGW88uHWQiZ7NoIhJ ZbFOycmmM+ahl+DGq8qSEZ4/MRLUF3g5v08aoXWvMLjy/reMU+c3CVSekMgXeWCMo 3k6ZpFjWH1C66hDoEPCUvxcBho5eV3dfJwOOnXY5GE2YOvVOw4aiwJt27MQ56WUxq bl91SU/DwL01uKA/I914azsfs9krT6AjB3hF30QWmYNIohNfmqcolfWlDLvlJwIxu MtI5JlH/b9gY4La/xFV+PFpS85VTjJyv+849TWulyInxcL6mgehnZGJn0cmGwFQ+8 uB7U8Br5rlhv2XBTUA== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [93.207.81.161] ([93.207.81.161]) by web-mail.gmx.net (3c-app-gmx-bs25.server.lan [172.19.170.77]) (via HTTP); Thu, 25 Jan 2024 22:26:45 +0100 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] Fortran: NULL actual to optional dummy with VALUE attribute [PR113377] Date: Thu, 25 Jan 2024 22:26:45 +0100 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:PDax7ZcQgrT5OT2e9Ls4JF/vMNw6cfx/2iJYBut/2oFVeV7tteT5B6fmzMspMfrlZPCEH qzfhkSOPSLz4T8sgFLwS0HRRnfvQuidV1yYJlq8sbCt1aIbTr8Mkzr/9iwY71riPZVY176jeSmhl Jk/KhEvkP0gFOq8MdPaBV1yXR8f2BnKpKokCK+PnENuX7mpqcSJYRUYeN777eKsuRW+Ujd/ejH6+ NCfOVxe0eyvLTDi7ThLLq4s5QGCzk+0MnE/uT0jYbUPthq3Ez2Hyr6utXQjdQz/dHe1W0uDcuARH 9E= UI-OutboundReport: notjunk:1;M01:P0:xk387rXgy9U=;KIjXNn72X0OksLs93SmJ0zADgUR zT8weyWkTIhoX63Sn63f2aOiKmQBtWTnosHoI7luKjVQcKzzNPeH0L9aCDu9WvoKcmjbfHcO1 +bUwYi24WPfAmcPrBxRqvEb42tIGB3fSkfU+/sHdVZH45BA7BR3EPql+ACH4DNsidEyQHUz7a ePZvrhrii+QsmcL1yFjYvTOpW5EGTyhy2yzUfia9hjw90ALVkpKDR4v+9nvh8Zt74JzqMWYbv isDXJCkRelT6mHXkxo8XVQWAvSpSSAjckRO0Kt1T9XxtaiQtXBrSyymOh1glyKp7Xgstx2Va1 C0QBlo4jUn/EJnptvtN6Wb7bOc1969wACIcbmaJeJj7JYupm6GDMuHHe0Mq43ybzR2E/oOTc5 TZKE0wKitrhKtoOMd6MGkAxlT6OgslOZfBZ0bRy92bIxLlPaGPpO5975TU5nSo8W3TA5ro6B3 1dK1DLpPNVnrV8Jke7kBUmfqeGVi1jaPoSLzMIGTfZxz1vIQ8ZkW09euoyRZQbr20kMj+OBSZ cg1B1QkTipcTbAkhd3P0mDneA8heg8YWsFnqSyszqcyvkVPNOKCR6cjS8Tx+5fGNMhlC7WzWH n509PmvJtMEZPQJPRgPbaoF9X9Rs777uQ00HoMckPaLTLTDQcHp0eEpz8qv6OwUe+AiWmGb+r DDOLWv846r1WKL1YYsd2ieIQij9tjkP9P11O43f7+qP2jYnj69nEL5pACkcfm991utcWi73fp ouhQIXspyfKf3WvNcbwRTgULGLTCP8tCabGWIcUOFVBxJai8GmhRMipt7g+N5qzbsRUjyIq4K 5VNFojHnLVtnFwqZjR00FquQ== X-Spam-Status: No, score=-10.6 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_BARRACUDACENTRAL, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H3, RCVD_IN_MSPIKE_WL, 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.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org X-getmail-retrieved-from-mailbox: INBOX X-GMAIL-THRID: 1789099303814298751 X-GMAIL-MSGID: 1789099303814298751 Dear all, this is the third patch in a series that addresses dummy arguments with the VALUE attribute, now handling the passing of NULL actual arguments. It is based on the refactoring in the previous patch and reuses the handling of absent arguments. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald From a0509b34d52b32a2e3511daefcb7dc308c755931 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Thu, 25 Jan 2024 22:19:10 +0100 Subject: [PATCH] Fortran: NULL actual to optional dummy with VALUE attribute [PR113377] gcc/fortran/ChangeLog: PR fortran/113377 * trans-expr.cc (conv_dummy_value): Treat NULL actual argument to optional dummy with the VALUE attribute as not present. (gfc_conv_procedure_call): Likewise. gcc/testsuite/ChangeLog: PR fortran/113377 * gfortran.dg/optional_absent_11.f90: New test. --- gcc/fortran/trans-expr.cc | 11 ++- .../gfortran.dg/optional_absent_11.f90 | 99 +++++++++++++++++++ 2 files changed, 108 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/optional_absent_11.f90 diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 3dc521fab9a..67abca9f6ba 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -6086,7 +6086,7 @@ conv_dummy_value (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym, gcc_assert (fsym && fsym->attr.value && !fsym->attr.dimension); /* Absent actual argument for optional scalar dummy. */ - if (e == NULL && fsym->attr.optional && !fsym->attr.dimension) + if ((e == NULL || e->expr_type == EXPR_NULL) && fsym->attr.optional) { /* For scalar arguments with VALUE attribute which are passed by value, pass "0" and a hidden argument for the optional status. */ @@ -6354,7 +6354,14 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, e->ts = temp_ts; } - if (e == NULL) + if (e == NULL + || (e->expr_type == EXPR_NULL + && fsym + && fsym->attr.value + && fsym->attr.optional + && !fsym->attr.dimension + && fsym->ts.type != BT_DERIVED + && fsym->ts.type != BT_CLASS)) { if (se->ignore_optional) { diff --git a/gcc/testsuite/gfortran.dg/optional_absent_11.f90 b/gcc/testsuite/gfortran.dg/optional_absent_11.f90 new file mode 100644 index 00000000000..1f63def46fa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/optional_absent_11.f90 @@ -0,0 +1,99 @@ +! { dg-do run } +! PR fortran/113377 +! +! Test that a NULL actual argument to an optional dummy is not present +! (see also F2018:15.5.2.12 on argument presence) + +program test_null_actual_is_absent + implicit none + integer :: k(4) = 1 + character :: c(4) = "#" + call one (k) + call three (c) +contains + subroutine one (i) + integer, intent(in) :: i(4) + integer :: kk = 2 + integer, allocatable :: aa + integer, pointer :: pp => NULL() + print *, "Scalar integer" + call two (kk, aa) + call two (kk, pp) + call two (kk, NULL()) + call two (kk, NULL(aa)) + call two (kk, NULL(pp)) + print *, "Elemental integer" + call two (i, aa) + call two (i, pp) + call two (i, NULL()) + call two (i, NULL(aa)) + call two (i, NULL(pp)) + print *, "Scalar integer; value" + call two_val (kk, aa) + call two_val (kk, pp) + call two_val (kk, NULL()) + call two_val (kk, NULL(aa)) + call two_val (kk, NULL(pp)) + print *, "Elemental integer; value" + call two_val (i, aa) + call two_val (i, pp) + call two_val (i, NULL()) + call two_val (i, NULL(aa)) + call two_val (i, NULL(pp)) + end + + elemental subroutine two (i, j) + integer, intent(in) :: i + integer, intent(in), optional :: j + if (present (j)) error stop 11 + end + + elemental subroutine two_val (i, j) + integer, intent(in) :: i + integer, value, optional :: j + if (present (j)) error stop 12 + end + + subroutine three (y) + character, intent(in) :: y(4) + character :: zz = "*" + character, allocatable :: aa + character, pointer :: pp => NULL() + print *, "Scalar character" + call four (zz, aa) + call four (zz, pp) + call four (zz, NULL()) + call four (zz, NULL(aa)) + call four (zz, NULL(pp)) + print *, "Elemental character" + call four (y, aa) + call four (y, pp) + call four (y, NULL()) + call four (y, NULL(aa)) + call four (y, NULL(pp)) + print *, "Scalar character; value" + call four_val (zz, aa) + call four_val (zz, pp) + call four_val (zz, NULL()) + call four_val (zz, NULL(aa)) + call four_val (zz, NULL(pp)) + print *, "Elemental character; value" + call four_val (y, aa) + call four_val (y, pp) + call four_val (y, NULL()) + call four_val (y, NULL(aa)) + call four_val (y, NULL(pp)) + end + + elemental subroutine four (i, j) + character, intent(in) :: i + character, intent(in), optional :: j + if (present (j)) error stop 21 + end + + elemental subroutine four_val (i, j) + character, intent(in) :: i + character, value, optional :: j + if (present (j)) error stop 22 + end +end -- 2.35.3