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 97F9A3858D35; Thu, 22 Jun 2023 20:23:26 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 97F9A3858D35 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=1687465405; x=1688070205; i=anlauf@gmx.de; bh=mLixfVnd/9HHu5NI62DVv4pQXBjxhvDxgJoh9LbX/60=; h=X-UI-Sender-Class:From:To:Subject:Date; b=ELtF5QEirtcj+Yt1a+YaVpw9uJwwFsLRegJuT4BWVQ06N9GZofzp/4yX+LuWFtCdtlWKbI0 BrwdJON2y9gK2sS6B0CEUWyF3qJZ3aI8OJ35Gzat6IeNf+u1Hh4FN2RP3Ld79Sm23C0qpa8gL Os3YU6Xk6hmxnIU8B+S1aDO8fwOuv/HG6EsM6ZcQjJAhg4aTqOVEddB7AgLGn6zYrkVRA9VDU tUqUB3dYaFV5lj01dttnbyS3n3awEiLt1yneOdCdpeCxe3vkBtsm49WScONfu2vPxpHxK+F9R FFh8tmqevSlUbC5WjdgzsatbWdo5/ECIpTnnFBxUMxAoqW+DMWuw== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [79.232.148.146] ([79.232.148.146]) by web-mail.gmx.net (3c-app-gmx-bs06.server.lan [172.19.170.55]) (via HTTP); Thu, 22 Jun 2023 22:23:24 +0200 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] Fortran: ABI for scalar CHARACTER(LEN=1),VALUE dummy argument [PR110360] Content-Type: multipart/mixed; boundary=rehcsed-a03b7f38-1a7e-4aaf-b343-bf49e04b971c Date: Thu, 22 Jun 2023 22:23:24 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:Ds06O3tt257Rw0TjF283so4FKYxpFJNUwi9Me1AgZaCU1amIcXJQMuLazHctn9+tf9poi wpvvhkMU8vMM1F22GHCWtvNJWsawUJHPJdPUwIMA4cIxGwthv5hrogP12jcVYhVy4iEuqUzWIChw FL5BOGXDrmO/m6FcCqowc2o1KO5KxV1Mq6sAOVaM+zp3iBTDaVKb9gbjsBZnPq6uETLNOGVe9gne G65xKHfHyR4NgHVC5BU1ZHZKC90FpTAZIMZxP4khmqKZdwXrcgX8zUoTUQTiUa1T4DSYEJ1DI6o/ YQ= UI-OutboundReport: notjunk:1;M01:P0:WLYlGYvzhVw=;aZ/E4pbDvp3X1DNfjPdHWsOSENF Ri554gfUeBNP1PuXoa3oEWJSD6pQPf1EB/3RIsOxA+NRa+sQNkBoolf6nqg/7jm3si6VvE931 6zlgmNOU8CtGcO5Z5D7KSSYLNn37CxknV7S8am2PWA/6XRhIQhxTrww/xQwVR2ctU9NOKnaIW 97Y8vmq0rpW3E8uza91tHE4Kfyxi9RG9WLXFwynCk+KXiyAuVauOwRVqM+XObfVZKPkjSANIS kmZV1R5+4uHcyQmAGFSA4XuHLujVB3zq9wmo5E0cl+IKbdXb27/TjIncRMQean+wmkOndctYH aJ38tGvrnXFMQVe/J/VgovziShDjWCH1nvGpx2e8rIyKeTJn8XFZzRMNEIVADOIsP6RGQKwFr vZaum02MME2bDGM3xrADrW6sWpGSnWEG3E8cXu55d4ezCwNGXuDTDXC9YF86azP+HPytEVJUp qLt5DLR2JSd3V+4o/IWqkJ/XQGySYw4N5igXwwgGgZCQ9AmZ6WSfRDLAFuq4YKwxOMRjaPqzI kCirLPtPTdgoDbEOUCOjFhVy8324rDW+dkAwfrThhO7Cd0MRmFNnQrmAL6lI3mbQqqyC/pKHB 9avHGMLj6Jeh1QUx8VhaNgqfKXlZ706MgQYIK6r0DuemGgCETi1dtbGXdaFzWToTO4MktxYrB 0OS4uXgXzhScv2sv9N6lJ5NzrCY7xdXjUyJ65lLt8DaB1IoOeFka54V4Nl+v9qDPZt3vRWWRS SYZ9Og8mvwa5GoOujSPqaXAU2igw5Qlx+udSPo7wP/LdBqwv12MjZwnUte+EtVLxVtKDXoD3b AbYfB3+MQuoH9dqlWtMbscqw== 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_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 List-Id: --rehcsed-a03b7f38-1a7e-4aaf-b343-bf49e04b971c Content-Type: text/plain; charset=UTF-8 Dear all, gfortran's ABI specifies that actual arguments to CHARACTER(LEN=1),VALUE dummy arguments are passed by value in the scalar case. That did work for constant strings being passed, but not in several other cases, where pointers were passed, resulting in subsequent random junk... The attached patch fixes this for the case of a non-constant string argument. It does not touch the character,value bind(c) case - this is a different thing and may need separate work, as Mikael pointed out - and there is a missed optimization for the case of actual constant string arguments of length larger than 1: it appears that the full string is pushed to the stack. I did not address that, as the primary aim here is to get correctly working code. (I added a TODO in a comment.) Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald --rehcsed-a03b7f38-1a7e-4aaf-b343-bf49e04b971c Content-Type: text/x-patch Content-Disposition: attachment; filename=pr110360.diff Content-Transfer-Encoding: quoted-printable =46rom bea1e14490e4abc4b67bae8fdca5196bb93acd2d Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Thu, 22 Jun 2023 22:07:41 +0200 Subject: [PATCH] Fortran: ABI for scalar CHARACTER(LEN=3D1),VALUE dummy ar= gument [PR110360] gcc/fortran/ChangeLog: PR fortran/110360 * trans-expr.cc (gfc_conv_procedure_call): Pass actual argument to scalar CHARACTER(1),VALUE dummy argument by value. gcc/testsuite/ChangeLog: PR fortran/110360 * gfortran.dg/value_9.f90: New test. =2D-- gcc/fortran/trans-expr.cc | 19 +++++++ gcc/testsuite/gfortran.dg/value_9.f90 | 78 +++++++++++++++++++++++++++ 2 files changed, 97 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/value_9.f90 diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 3c209bcde97..c92fccd0be2 100644 =2D-- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -6392,6 +6392,25 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * = sym, else { gfc_conv_expr (&parmse, e); + + /* ABI: actual arguments to CHARACTER(len=3D1),VALUE + dummy arguments are actually passed by value. + The BIND(C) case is handled elsewhere. + TODO: truncate constant strings to length 1. */ + if (fsym->ts.type =3D=3D BT_CHARACTER + && !fsym->ts.is_c_interop + && fsym->ts.u.cl->length->expr_type =3D=3D EXPR_CONSTANT + && fsym->ts.u.cl->length->ts.type =3D=3D BT_INTEGER + && (mpz_cmp_ui + (fsym->ts.u.cl->length->value.integer, 1) =3D=3D 0) + && e->expr_type !=3D EXPR_CONSTANT) + { + parmse.expr =3D gfc_string_to_single_character + (build_int_cst (gfc_charlen_type_node, 1), + parmse.expr, + e->ts.kind); + } + if (fsym->attr.optional && fsym->ts.type !=3D BT_CLASS && fsym->ts.type !=3D BT_DERIVED) diff --git a/gcc/testsuite/gfortran.dg/value_9.f90 b/gcc/testsuite/gfortra= n.dg/value_9.f90 new file mode 100644 index 00000000000..f6490645e27 =2D-- /dev/null +++ b/gcc/testsuite/gfortran.dg/value_9.f90 @@ -0,0 +1,78 @@ +! { dg-do run } +! PR fortran/110360 - ABI for scalar character(len=3D1),value dummy argum= ent + +program p + implicit none + character, allocatable :: ca + character, pointer :: cp + character(len=3D:), allocatable :: cd + character (kind=3D4), allocatable :: ca4 + character (kind=3D4), pointer :: cp4 + character(len=3D:,kind=3D4), allocatable :: cd4 + integer :: a =3D 65 + allocate (ca, cp, ca4, cp4) + + ! Check len=3D1 actual argument cases first + ca =3D "a"; cp =3D "b"; cd =3D "c" + ca4 =3D 4_"d"; cp4 =3D 4_"e"; cd4 =3D 4_"f" + call val ("B","B") + call val ("A",char(65)) + call val ("A",char(a)) + call val ("A",mychar(65)) + call val ("A",mychar(a)) + call val4 (4_"C",4_"C") + call val4 (4_"A",char(65,kind=3D4)) + call val4 (4_"A",char(a, kind=3D4)) + call val (ca,ca) + call val (cp,cp) + call val (cd,cd) + call val4 (ca4,ca4) + call val4 (cp4,cp4) + call val4 (cd4,cd4) + call sub ("S") + call sub4 (4_"T") + + ! Check that always the first character of the string is finally used + call val ( "U++", "U--") + call val4 (4_"V**",4_"V//") + call sub ( "WTY") + call sub4 (4_"ZXV") + cd =3D "gkl"; cd4 =3D 4_"hmn" + call val (cd,cd) + call val4 (cd4,cd4) + call sub (cd) + call sub4 (cd4) + deallocate (ca, cp, ca4, cp4, cd, cd4) +contains + subroutine val (x, c) + character(kind=3D1), intent(in) :: x ! control: pass by reference + character(kind=3D1), value :: c + print *, "by value(kind=3D1): ", c + if (c /=3D x) stop 1 + c =3D "*" + if (c /=3D "*") stop 2 + end + + subroutine val4 (x, c) + character(kind=3D4), intent(in) :: x ! control: pass by reference + character(kind=3D4), value :: c + print *, "by value(kind=3D4): ", c + if (c /=3D x) stop 3 + c =3D 4_"#" + if (c /=3D 4_"#") stop 4 + end + + subroutine sub (s) + character(*), intent(in) :: s + call val (s, s) + end + subroutine sub4 (s) + character(kind=3D4,len=3D*), intent(in) :: s + call val4 (s, s) + end + + character function mychar (i) + integer, intent(in) :: i + mychar =3D char (i) + end +end =2D- 2.35.3 --rehcsed-a03b7f38-1a7e-4aaf-b343-bf49e04b971c--