From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: 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 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.de; s=s31663417; t=1690486793; x=1691091593; i=anlauf@gmx.de; bh=Cq7l+s7lRyE1XUeWgzjQMuq187E9y+JRsZUTf5ETbOo=; h=X-UI-Sender-Class:From:To:Subject:Date; b=huR2Z6KWRlCxRXxsQgdDIW+Y6c0sKZiSYWw/2zZB3/NhVzRqJmeEUjVYAYmxh8htljU6Dk+ KkKRY48ZGSwmVf4ry0KIPTywOkVLotQMtfHwfXJ1XB3N9JQodr2rYNL4cQlEM7HGBR0o/g4JM SiwEHuIBazGxLcUirINSGy07quFsW5c1alMftmnSKw+vt0nFad9UaQXUAXFoMJtOptmsCi1gL 5T3QNZkfaSTOsVTUJEDVm5lyGozF8ijcsj8YqePVOe1iTex5+mdE8cOmWOEK/9+GDmj5m3t9l HPB4vrye077eCvwWknb08RDpjJbDkxHXsk8tRpiVht8lWmzSWbFQ== 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: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] Fortran: do not pass hidden character length for TYPE(*) dummy [PR110825] Content-Type: multipart/mixed; boundary=rekceb-a7d773c2-07e7-4789-93aa-a1c20e7ead3e 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 List-Id: --rekceb-a7d773c2-07e7-4789-93aa-a1c20e7ead3e Content-Type: text/plain; charset=UTF-8 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 --rekceb-a7d773c2-07e7-4789-93aa-a1c20e7ead3e Content-Type: text/x-patch Content-Disposition: attachment; filename=pr110825.diff Content-Transfer-Encoding: quoted-printable =46rom 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. =2D-- 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 =2D-- 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 @c= ode{_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=3DC_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 =2D-- 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 * s= ym, && !(fsym && fsym->ts.type =3D=3D BT_DERIVED && fsym->ts.u.derived && fsym->ts.u.derived->intmod_sym_id =3D=3D ISOCBINDING_PTR && fsym->ts.u.derived->from_intmod =3D=3D INTMOD_ISO_C_BINDING ) + && !(fsym && fsym->ts.type =3D=3D 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 =2D-- /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 =3D "" + character(:), allocatable :: deferred + character :: c42(6,7) =3D "*" + call sub (not_used, "123") + call sub ("0" , "123") + deferred =3D "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) /=3D 3) stop 1 + if (len_trim (print_this) /=3D 3) stop 2 + end + + subroutine sub2 (a, c) + type(*), intent(in) :: a(:) + character(*), intent(in) :: c + if (len (c) /=3D 3) stop 10 + if (len_trim (c) /=3D 3) stop 11 + if (size (a) /=3D 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) /=3D 3) stop 20 + if (len_trim (c) /=3D 3) stop 21 + if (.not. present (a)) stop 22 + if (rank (a) /=3D 2) stop 23 + if (size (a) /=3D 42) stop 24 + if (any (shape (a) /=3D [6,7])) stop 25 + if (any (lbound (a) /=3D [1,1])) stop 26 + if (any (ubound (a) /=3D [6,7])) stop 27 + if (.not. is_contiguous (a)) stop 28 + cpt =3D c_loc (a) + if (.not. c_associated (cpt)) stop 29 + end + +end =2D- 2.35.3 --rekceb-a7d773c2-07e7-4789-93aa-a1c20e7ead3e--