From patchwork Thu Jul 27 19:39:53 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 127129 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:a985:0:b0:3e4:2afc:c1 with SMTP id t5csp1324913vqo; Thu, 27 Jul 2023 12:41:02 -0700 (PDT) X-Google-Smtp-Source: APBJJlGUlBllQh4UQLPLZ2SK8BdhCvTFNxnEPbTp9jScFXJFnG53Ntjvc+CIPe+Q3PsHOgDTPjwE X-Received: by 2002:a17:906:13:b0:99b:de31:6666 with SMTP id 19-20020a170906001300b0099bde316666mr152354eja.22.1690486862457; Thu, 27 Jul 2023 12:41:02 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1690486862; cv=none; d=google.com; s=arc-20160816; b=LlfgFuwfIjDAaOd4RZPbCRJPilqNvq31pRWuznXYmI3y57oEKYA2ssHEND11R1bqen rOCHZA+uI4gvihhgu6PWI15sawlThd5i8/tm1GmfBXp0EMpubepkihGhOQwrE28FY5ac HJ9y7E0/GrLh3+72QqXdj1eFEW0zKeJXVsGPbRayRE76MNVYCTOhWjir1hL/nMgxNdRU WopuadYgd35Acwfs+j0KIJw5QEV1Kq+mZPbOx7XURJTjisNClJBRwdL/TRA94TqDB/xv JVEKAfLbjqazhpGRClkRTJcRa97q0HTPmdRvOUxQrff6V1rNyI4A0fcLO7JXardxnDFO 2WmQ== 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=1mom4s3XONLK44EQEs/G8pfElTfTKrwawei+P2sLS3w=; fh=QK0YdXSiSCa48e9o4Ff7k6xpBN/ax2bSUZqWzYlsl7Q=; b=KqB3zxm4/FFfCa1ZQ1fcpseQyN7qy8OZAbqSlgmBAXgld5P/umCuGHRbjAOkJQgMa2 eFHUi225rm4U9cKe/1fptiu6MXjDFX2Vgq2zPYxp21fd6b8po2X+V6OmTpIa0ZasO76+ 6JQP9HqU6ui2OyZrmiDTgbH64SDjwTZezNFxKJxO7JLLWuBYSWtpWqsTShWFwHkXQ78d 0uo6xH0jMMYm8HIXfDg0zDK+WD5AGlFv7JuQvuKrxV1osLnsh0Vuv8UCIm/bJDm/qG6A Jou4TYanh6dqN8gJo44R5W+GfX00TzouP444DhKJR+06dvi7WII0nR5jjFddO9V8fOR2 T5qA== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b="j/+PYZad"; 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 (ip-8-43-85-97.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id re18-20020a170906d8d200b009936afb1e23si1412203ejb.130.2023.07.27.12.41.02 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 27 Jul 2023 12:41:02 -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="j/+PYZad"; 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 5817C3854C45 for ; Thu, 27 Jul 2023 19:40:41 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 5817C3854C45 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1690486841; bh=1mom4s3XONLK44EQEs/G8pfElTfTKrwawei+P2sLS3w=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=j/+PYZadtY/TUG4A/cQ1fikdEP29wTMXZBr4mAMuWqGYOoGVR5AtWH8X/hhOUzXvc OSd22otsFM19ZfQolz5MxakHLFBm3NOJRS/a29vnw9by9yeqImm9jGDM97RtT4cRP5 1jDDSxQ+hM00RTOyytex8t+cHmmxthrCgUM0hz64= 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.18]) by sourceware.org (Postfix) with ESMTPS id A06403856951; Thu, 27 Jul 2023 19:39:55 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org A06403856951 X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [93.207.81.190] ([93.207.81.190]) by web-mail.gmx.net (3c-app-gmx-bs10.server.lan [172.19.170.61]) (via HTTP); Thu, 27 Jul 2023 21:39:53 +0200 MIME-Version: 1.0 Message-ID: To: fortran , gcc-patches Subject: [PATCH] Fortran: do not pass hidden character length for TYPE(*) dummy [PR110825] Date: Thu, 27 Jul 2023 21:39:53 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:9N7qrBXkrpp2LiALjnBdgcZzSsZxPa2ZekKYWgG5VNnzXwzGc3/q8iNpfEcpK80gu2kR7 nRSqNTXdcnbo/b8UcJCNxq1W8vZMY1uWYZ7i2L2cLWkMkSWl0CyGA5N4q/UsJiYtjdUP+0nmM/JK S4+sejrODkLvywGD9rsD3wN/RQHutgWA8+OwSrra9NbrGqoLLiYkpRYiILRLwE5eoZyKrJrfTJNu ioQLH+SIIJu2bsaM37kom6+AwURQPeVjGknegIaWvBVQ49W/OMvpVoObLxK1smBbSyO16l3rJo+r aA= UI-OutboundReport: notjunk:1;M01:P0:RlrBK7Sg7fg=;OJAiqcSRrMtAbcTYSUmeC7AVOjw fEY+FMOSewj78LJ2ElhOVBYCaGCeqqlazUWtibZTf7fTVZWVo5vbRZXlBaTuwEaR+VEszAbsm UoFm1Wf5tU1D7mEvJbgMPsYj8yLr3vST3PT2hZ0BpEqojMp2OlU4FAeZXM8mgAUoaFISCxOfn NrvevnVP9H/T3KRT/QwexuuGvXfeAKnneQ2FE/K4fnSNwT9UiOL9yLMgp46/uu3LptapjZehl YYGKJrsD8wAY9pJ7E+/BUHGgNCXvGBbXME20aDeLGeIGdlkf5TJBJ1CmQVnAqPyy2kYgdPdtb 1dfbQ/RKsOuel1D7vtrKXjmMfrwBzNXZz9rpEQ37pWjokgtAvmkyeQGAnKIXEskdHE2GlDGqT zAp0u1+kg76fg2YlzpivPzY/4OqNV/19RWNTV0S+reGMYtJx1EWZu/X0JFDYtkTxjclgZojEx nud7LQ9wQVLZrr+v+DeidaDxzg9o6lERa8F0d5TVqimkb2KpRqq/zAAK1Qk+Qc8wXtj3C/euF EZ2h5cScCLqtDbFKUlmmf4tYBvO8hivz0qzoU8qI1bjkS7ECb8xcmm7KwgPIiYYPMHDp+oEFS VEA6BFKRjvsPL2biHhqG/b8LnSQOAnYTIDsGwQarSDgJZleR59Uv5j4XGPuMQh4VNq8y2dnyK AhYWKiPBPRY9ka7OaIZtX5lEVamyG7AzD0vnTh844RJG++orfHaOk5xWEV5m7E1kFkPW6m1hI leuwwKjQunjL9CTOKarSQkzUL/zQYToPnO1ItDs122klbc1CXI9yN89df4CdGbKkOgm46KHql ImcGmdn8tZx4XVOF8AcdpbGQ== X-Spam-Status: No, score=-12.6 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_H2, 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: INBOX X-GMAIL-THRID: 1772603952360412246 X-GMAIL-MSGID: 1772603952360412246 Dear all, when passing a character actual argument to an assumed-type dummy (TYPE(*)), we should not pass the character length for that argument, as otherwise other hidden arguments that are passed as part of the gfortran ABI will not be interpreted correctly. This is in line with the current way the procedure decl is generated. The attached patch fixes the caller and clarifies the behavior in the documentation. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald From 199e09c9862f5afe7e583839bc1b108c741a7efb Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Thu, 27 Jul 2023 21:30:26 +0200 Subject: [PATCH] Fortran: do not pass hidden character length for TYPE(*) dummy [PR110825] gcc/fortran/ChangeLog: PR fortran/110825 * gfortran.texi: Clarify argument passing convention. * trans-expr.cc (gfc_conv_procedure_call): Do not pass the character length as hidden argument when the declared dummy argument is assumed-type. gcc/testsuite/ChangeLog: PR fortran/110825 * gfortran.dg/assumed_type_18.f90: New test. --- gcc/fortran/gfortran.texi | 3 +- gcc/fortran/trans-expr.cc | 1 + gcc/testsuite/gfortran.dg/assumed_type_18.f90 | 52 +++++++++++++++++++ 3 files changed, 55 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/assumed_type_18.f90 diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi index 7786d23265f..f476a3719f5 100644 --- a/gcc/fortran/gfortran.texi +++ b/gcc/fortran/gfortran.texi @@ -3750,7 +3750,8 @@ front ends of GCC, e.g. to GCC's C99 compiler for @code{_Bool} or GCC's Ada compiler for @code{Boolean}.) For arguments of @code{CHARACTER} type, the character length is passed -as a hidden argument at the end of the argument list. For +as a hidden argument at the end of the argument list, except when the +corresponding dummy argument is declared as @code{TYPE(*)}. For deferred-length strings, the value is passed by reference, otherwise by value. The character length has the C type @code{size_t} (or @code{INTEGER(kind=C_SIZE_T)} in Fortran). Note that this is diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index ef3e6d08f78..764565476af 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -7521,6 +7521,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, && !(fsym && fsym->ts.type == BT_DERIVED && fsym->ts.u.derived && fsym->ts.u.derived->intmod_sym_id == ISOCBINDING_PTR && fsym->ts.u.derived->from_intmod == INTMOD_ISO_C_BINDING ) + && !(fsym && fsym->ts.type == BT_ASSUMED) && !(fsym && UNLIMITED_POLY (fsym))) vec_safe_push (stringargs, parmse.string_length); diff --git a/gcc/testsuite/gfortran.dg/assumed_type_18.f90 b/gcc/testsuite/gfortran.dg/assumed_type_18.f90 new file mode 100644 index 00000000000..a3d791919a2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/assumed_type_18.f90 @@ -0,0 +1,52 @@ +! { dg-do run } +! PR fortran/110825 - TYPE(*) and character actual arguments + +program foo + use iso_c_binding, only: c_loc, c_ptr, c_associated + implicit none + character(100) :: not_used = "" + character(:), allocatable :: deferred + character :: c42(6,7) = "*" + call sub (not_used, "123") + call sub ("0" , "123") + deferred = "d" + call sub (deferred , "123") + call sub2 ([1.0,2.0], "123") + call sub2 (["1","2"], "123") + call sub3 (c42 , "123") + +contains + + subroutine sub (useless_var, print_this) + type(*), intent(in) :: useless_var + character(*), intent(in) :: print_this + if (len (print_this) /= 3) stop 1 + if (len_trim (print_this) /= 3) stop 2 + end + + subroutine sub2 (a, c) + type(*), intent(in) :: a(:) + character(*), intent(in) :: c + if (len (c) /= 3) stop 10 + if (len_trim (c) /= 3) stop 11 + if (size (a) /= 2) stop 12 + end + + subroutine sub3 (a, c) + type(*), intent(in), target, optional :: a(..) + character(*), intent(in) :: c + type(c_ptr) :: cpt + if (len (c) /= 3) stop 20 + if (len_trim (c) /= 3) stop 21 + if (.not. present (a)) stop 22 + if (rank (a) /= 2) stop 23 + if (size (a) /= 42) stop 24 + if (any (shape (a) /= [6,7])) stop 25 + if (any (lbound (a) /= [1,1])) stop 26 + if (any (ubound (a) /= [6,7])) stop 27 + if (.not. is_contiguous (a)) stop 28 + cpt = c_loc (a) + if (.not. c_associated (cpt)) stop 29 + end + +end -- 2.35.3