From patchwork Mon Feb 12 20:57:08 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 200030 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a05:7300:bc8a:b0:106:860b:bbdd with SMTP id dn10csp163243dyb; Mon, 12 Feb 2024 12:58:00 -0800 (PST) X-Google-Smtp-Source: AGHT+IFHxzoldxARCr8MzehGkXoWJpU32OwsmtsjWACiZmaLzOFc2A8/wks5bxiEhMUm0rtZK9F6 X-Received: by 2002:a0c:e08d:0:b0:68c:a5fc:e02f with SMTP id l13-20020a0ce08d000000b0068ca5fce02fmr8423102qvk.21.1707771480095; Mon, 12 Feb 2024 12:58:00 -0800 (PST) ARC-Seal: i=2; a=rsa-sha256; t=1707771480; cv=pass; d=google.com; s=arc-20160816; b=M7SLZd9cCY1qVzvKc2dQ44QW9TFhXjZG6dKG4Pa/5JcZ9Y0Dw3iD/TYDru9MYjyimi a9HN32AztJbvUpsPsjuU671jjnEfanISp9OlmqEAK3LCRRiQ8r7Y9aXWJFb1VSGSohqh OclXZ339uIRZY8S8UYCdDqJRE5WJglYmOkokOebOC1njWa9IYnynHZ8PHhWdRncj5PjQ 8+6RSaESHISL3SzFBRRPYTCSj2pusC5uw9Oha9j5yhD05IQEuVEUqf/OGHfcTk2giRS+ A955mB1/4WZCYCQmwKovoY+C7NRo6ow0zEgfrMJ71kIrhENq3JPdnNvibykT0gsSN3Rp aBjg== 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=Yd94pI/GPsj+aQEyrxbMyUnkjApeEpTNhMWNLD/NOJc=; fh=6vtsCXfz/1dtYnvljsLQsAorIMEbfbw0XHXYb2NWGJY=; b=aasdzUjAQI//dJvCV3OYROuLu6s28RY4ebpmfvtlI7o9FvWkiwBrnglXIcyuYpYU4n aDfwlX3JCD7SvILgGN/kylUujwgVbq1cN6CnEJQrDSZ+5VewP565BtPrEjj3OJ5IoH4W Ve032qVRhATfelnLF767QFP13dLEjRfSxvja1ByDMFqxy0xT1y40ilSkui8XwCMeeQJs cmA+lsri5oWEBV4gNxGgRM/8GGfBAvHme1aEBKnQSfPD8fQzzt+v1wo+684s0PSBGHY+ PP4Kms3Aoo3rpLzjZ5rn+8hS0vmn8Qxx0fpQTwHl6PPqLsbCGCQPZfYM/mWRjxm/Tm7r qrQA==; dara=google.com ARC-Authentication-Results: i=2; mx.google.com; dkim=pass header.i=@gmx.de header.s=s31663417 header.b=kqGMtaKU; 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 X-Forwarded-Encrypted: i=2; AJvYcCVAgr5DgeUDtw0nhwmgU/OHDYRDxqTl/IEAwSezKc9N78F+W5z62dgh/xr1CdOd/hCpd9tCZptxrxIAXUcSjOC8GILCcA== Received: from server2.sourceware.org (server2.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id kc27-20020a056214411b00b0068cc112c468si1308203qvb.16.2024.02.12.12.57.59 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 12 Feb 2024 12:58:00 -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=kqGMtaKU; 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 C3FFC3858402 for ; Mon, 12 Feb 2024 20:57:59 +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.17.21]) by sourceware.org (Postfix) with ESMTPS id F15503858C52; Mon, 12 Feb 2024 20:57:09 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org F15503858C52 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 F15503858C52 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=212.227.17.21 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1707771434; cv=none; b=FKDyEPSDK6XPQHfoE61sJ7gffHQCi7WJGbsV3BZneFaEbrqAaeMIQZkKJVdT0kO3nTXz7YC5d+ZHmIgy/ND8a919awmzYpQrSpFTtGrYyQ78c3Zwbi70bsFbqmWhLhH9eebDDmGd/FTQn00alDxKPzwz+kmyoRcEtIbzUGwiiVg= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1707771434; c=relaxed/simple; bh=fOV8fijSQRGq2RmmPnI4XDZOeYZTCFKM5hF0bGGMCLI=; h=DKIM-Signature:MIME-Version:Message-ID:From:To:Subject:Date; b=jMu4o0XGel1f+r2Ae+0qaGDKgwJWiaMoVwTrN80/ccbX8zZsZjxTMzaXwQNIRTWrhBF0riJGpKCP7q8FUcQTrr5IYLvPTG+oKR91qglIvALrFJN1o7OKJ+17JEq904xU+qhbevsvBilZn4vtqhGG9IVzusRZBw1LOirV2sPRWxs= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.de; s=s31663417; t=1707771428; x=1708376228; i=anlauf@gmx.de; bh=fOV8fijSQRGq2RmmPnI4XDZOeYZTCFKM5hF0bGGMCLI=; h=X-UI-Sender-Class:From:To:Subject:Date; b=kqGMtaKUVGoGSYoThRi/gpghmnjJYuAUK+Dnpxn5ccysXkjM1eEus9y6vlRODAqP pDAnfxTEMNoUkJMuEmO8XRsDA0JGchXQXmj+WSQ1s+ul5BxbFGYmtv/dCepD7lX7c hcVAl+wlSH2MvONeP+4UBhh0KDcnUtlpI5qSHwTAjwTR70RFvnqrFkAY6ODLOHXu2 e6F2aVm4jbsMqz6a1vr/bRt+r9ZlQhdwJxHPotXRDkYPHuWRxwlMwILJYA3NFNtZi hEvbUlVozfxDubXoK7R1kPQw+DEb9W4yGVOX1uDOjczxfNxZEf9UPvKnKg0DVFnH3 m5KpXYLX//o8gxrazw== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [79.251.14.202] ([79.251.14.202]) by web-mail.gmx.net (3c-app-gmx-bap22.server.lan [172.19.172.92]) (via HTTP); Mon, 12 Feb 2024 21:57:08 +0100 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] Fortran: fix passing of optional dummies to bind(c) procedures [PR113866] Date: Mon, 12 Feb 2024 21:57:08 +0100 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:AWfp03up/DsGwsb+H5EXG5zgPf/ZIF/8TrkviBvvaze/+kgcdWyVOFAPW2VWl1j/AFbdz 5IKiTpjafNJRW0HEW1re1TUX80IK0+iuZFoSt14iusHCWgumRpG8xwBYLo9uXKVZ+rY/+GsDSmQf mLnNrJU+RuvYhzwDskpoxjmiXLImp3BTLvzQbCya1KCJlwp4g7mubuB8B+NV5jy2U7xAALZ1YygY OypQ8ZxU7h1+PIJVJl2ivL5s/b3n8mIiqjfyBDWafIiDDnQMlYy8/MmXJJUTCwXE9w5B1bVaYLm4 3g= UI-OutboundReport: notjunk:1;M01:P0:S7YY8lgn5Qw=;T0habreN6pdbLY23trXOMwFujlp ta1Qot0IW1fm6guMzrUSAyt2mkA6AN5c4m8zQpzaYgGTlxu8KjgOg/jc+d+hEbChEcZbWz05u NtcQ+dICPAixV3YXSDNFRGXdXX0Qwi+quw2MAj9/ZX9q/vcLLxN+6D+4SeiOsXYjjd4xlvucZ kOUnrb9n3Rw6XQP8ylWtrk+jOeMyeYDeMxeSRFX+EMbTwJeXLdotrf4+V05X909y+1NsaFqc5 /v2CVOfujLuF8OOn40zOJ/qa9HHJOFWfRP7DGUFj8kD1m2Y1aPm9P1IktlbC+XHN9DczgjOcD YjeJaee5nxGenHpyAHD+RCtVwGaUZxyrJgNFHlnrLildgI+atUTLcfVXD0BpMudD7SJK4zB6M YJhl/hPQ2iVHUv7/+R2uanunP0Y0Pmf0vriBaYrBCeUzHqRqZDqo4wzqgRF2P8di8llaRZs7l gro9Bo4U7523Mv7SYPESeMWJbtQJzRRoOgIBSYDaPpq6SEZKjimDQyNFo5NHvx28Jti8jo7gI RPx4oH82NKYZD4wD2oD0DWSKSooxjqgMp2uZz7KTzYHq1OXEUQSe0CPMpbXBW6AgD6r+TPhra wO1N+nISg2FubO4dRh0pNLZ3zE+wmicRE333yZISco4fmP9JVOIGJqr3zbdeRQdhHEMh/sM7A 9MaEcdxz1Z1xrcH9r76hEeHNOnXe7WaQn8Yfm7WOCjEofimmzFWGesJdUnJ6JxU= X-Spam-Status: No, score=-12.5 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, 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: 1790728187585701021 X-GMAIL-MSGID: 1790728187585701021 Dear all, the attached patch fixes a mis-handling of optional dummy arguments passed to optional dummy arguments of procedures with the bind(c) attribute. When those procedures are expecting CFI descriptors, there is no special treatment like a presence check necessary that by default passes a NULL pointer as default. The testcase tries to exercise various combinations of passing assumed-length character between bind(c) and non-bind(c), which apparently was insufficiently covered in the testsuite. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald From 87d1b973a4d6a561dc3f3a0c4c10f76d155fa000 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Mon, 12 Feb 2024 21:39:09 +0100 Subject: [PATCH] Fortran: fix passing of optional dummies to bind(c) procedures [PR113866] PR fortran/113866 gcc/fortran/ChangeLog: * trans-expr.cc (gfc_conv_procedure_call): When passing an optional dummy argument to an optional dummy argument of a bind(c) procedure and the dummy argument is passed via a CFI descriptor, no special presence check and passing of a default NULL pointer is needed. gcc/testsuite/ChangeLog: * gfortran.dg/bind_c_optional-2.f90: New test. --- gcc/fortran/trans-expr.cc | 6 +- .../gfortran.dg/bind_c_optional-2.f90 | 104 ++++++++++++++++++ 2 files changed, 108 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/bind_c_optional-2.f90 diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 67abca9f6ba..a0593b76f18 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -7269,8 +7269,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, with an interface indicating an optional argument. When we call an intrinsic subroutine, however, fsym is NULL, but we might still have an optional argument, so we proceed to the substitution - just in case. */ - if (e && (fsym == NULL || fsym->attr.optional)) + just in case. Arguments passed to bind(c) procedures via CFI + descriptors are handled elsewhere. */ + if (e && (fsym == NULL || fsym->attr.optional) + && !(sym->attr.is_bind_c && is_CFI_desc (fsym, NULL))) { /* If an optional argument is itself an optional dummy argument, check its presence and substitute a null if absent. This is diff --git a/gcc/testsuite/gfortran.dg/bind_c_optional-2.f90 b/gcc/testsuite/gfortran.dg/bind_c_optional-2.f90 new file mode 100644 index 00000000000..b8b4c87775e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bind_c_optional-2.f90 @@ -0,0 +1,104 @@ +! { dg-do run } +! PR fortran/113866 +! +! Check interoperability of assumed-length character (optional and +! non-optional) dummies between bind(c) and non-bind(c) procedures + +module bindcchar + implicit none + integer, parameter :: n = 100, l = 10 +contains + subroutine bindc_optional (c2, c4) bind(c) + character(*), optional :: c2, c4(n) +! print *, c2(1:3) +! print *, c4(5)(1:3) + if (.not. present (c2) .or. .not. present (c4)) stop 8 + if (c2(1:3) /= "a23") stop 1 + if (c4(5)(1:3) /= "bcd") stop 2 + if (len (c2) /= l .or. len (c4) /= l) stop 81 + end + + subroutine bindc (c2, c4) bind(c) + character(*) :: c2, c4(n) + if (c2(1:3) /= "a23") stop 3 + if (c4(5)(1:3) /= "bcd") stop 4 + if (len (c2) /= l .or. len (c4) /= l) stop 82 + call bindc_optional (c2, c4) + end + + subroutine not_bindc_optional (c1, c3) + character(*), optional :: c1, c3(n) + if (.not. present (c1) .or. .not. present (c3)) stop 5 + call bindc_optional (c1, c3) + call bindc (c1, c3) + if (len (c1) /= l .or. len (c3) /= l) stop 83 + end + + subroutine not_bindc_optional_deferred (c5, c6) + character(:), allocatable, optional :: c5, c6(:) + if (.not. present (c5) .or. .not. present (c6)) stop 6 + call not_bindc_optional (c5, c6) + call bindc_optional (c5, c6) + call bindc (c5, c6) + if (len (c5) /= l .or. len (c6) /= l) stop 84 + end + + subroutine not_bindc_optional2 (c7, c8) + character(*), optional :: c7, c8(:) + if (.not. present (c7) .or. .not. present (c8)) stop 7 + call bindc_optional (c7, c8) + call bindc (c7, c8) + if (len (c7) /= l .or. len (c8) /= l) stop 85 + end + + subroutine bindc_optional2 (c2, c4) bind(c) + character(*), optional :: c2, c4(n) + if (.not. present (c2) .or. .not. present (c4)) stop 8 + if (c2(1:3) /= "a23") stop 9 + if (c4(5)(1:3) /= "bcd") stop 10 + call bindc_optional (c2, c4) + call not_bindc_optional (c2, c4) + if (len (c2) /= l .or. len (c4) /= l) stop 86 + end + + subroutine bindc_optional_missing (c1, c2, c3, c4, c5) bind(c) + character(*), optional :: c1, c2(n), c3(:), c4(..), c5(*) + if (present (c1)) stop 11 + if (present (c2)) stop 12 + if (present (c3)) stop 13 + if (present (c4)) stop 14 + if (present (c5)) stop 15 + end + + subroutine non_bindc_optional_missing (c1, c2, c3, c4, c5) + character(*), optional :: c1, c2(n), c3(:), c4(..), c5(*) + if (present (c1)) stop 21 + if (present (c2)) stop 22 + if (present (c3)) stop 23 + if (present (c4)) stop 24 + if (present (c5)) stop 25 + end +end module + +program p + use bindcchar + implicit none + character(l) :: a, b(n) + character(:), allocatable :: d, e(:) + a = 'a234567890' + b = 'bcdefghijk' + call not_bindc_optional (a, b) + call bindc_optional (a, b) + call not_bindc_optional2 (a, b) + call bindc_optional2 (a, b) + allocate (d, source=a) + allocate (e, source=b) + call not_bindc_optional (d, e) + call bindc_optional (d, e) + call not_bindc_optional2 (d, e) + call not_bindc_optional_deferred (d, e) + call bindc_optional2 (d, e) + deallocate (d, e) + call non_bindc_optional_missing () + call bindc_optional_missing () +end -- 2.35.3