From patchwork Wed Aug 9 20:21:21 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Mikael Morin X-Patchwork-Id: 133482 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:c44e:0:b0:3f2:4152:657d with SMTP id w14csp3053231vqr; Wed, 9 Aug 2023 13:23:34 -0700 (PDT) X-Google-Smtp-Source: AGHT+IHTlFfsQ4JMddKJ7tRYpiHcIDJo8k7oHopgq8wtcm7q1fIsH+rkTmhhH6QrVxr7AoE1RGgf X-Received: by 2002:a17:906:7486:b0:993:a379:6158 with SMTP id e6-20020a170906748600b00993a3796158mr173504ejl.17.1691612614536; Wed, 09 Aug 2023 13:23:34 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1691612614; cv=none; d=google.com; s=arc-20160816; b=bZJB0IPkfXZ3ru5u8/LJ+CQz3ozyVRSQzUt534J1mjZ4vBfs1l+/NXX0JN6G/G04uW QP10WWk+57gRqFrGE1giKAvhtdKi6+vgF8kCmn1R/lNELr/eFaAYg/ANAzdBqenxtb7m tuqHOAWm9rKSphetW2IaeClX6FN5vxkwS5UHmCseGSADcNr5Wop1sSkQmwJnQz3zt6Ch 8e8l8Ub+z/ErbTkMsVE2UJU19TRWP7o0TZ4cO+fUKDHu8dB00YTpeocn/tTQ1V2KOWJS bwM9UcfDXpcSbz2A7x70kPLix1v0I/8Ev7GHulXY0fsMKif8uENZsQabQ2MAcDeHf4ES 2DpQ== 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 :content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:to:dmarc-filter:delivered-to:dkim-signature :dkim-filter; bh=roXJLX87D3PEziMM+T/4FjCL7spMw/L5ANJUPDiurWE=; fh=EAqAZnhg4AYtcBjfPm18lEF5V0R2rkI9MSWQf+svVaI=; b=nJukJl+7itReDUAxWwrGSrdCxHyps1aC+GSOFVAfPdd3doh6Vt70oUuFtCkVr9jJ5p J1w5Eq7zV8wIrT4735uzaeZQlEfy7Z192rAR7gjK733r5y7+A84mI+4718HcldXjue52 UeMDFRCnP1a62Q0hKNiu7rHvwPr9dzfKJGdO3lMpbbg25pd7Tztjh5k2mTZ74PbSyvxv ffRHglLVMFsOy5R5rEDHp5RQbaDrNvQDCOYUqkzXxy2Xxd5aW0rk5Tzc6KMirJrjjBRL wiiynUYmZ8Ix8aotCxJSYjFEgMx6RheG7OtSTMjb69e+Cy36yqjcs1pISPoQDLzCNvtY OAig== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=IYBEp2I6; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c 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 (server2.sourceware.org. [2620:52:3:1:0:246e:9693:128c]) by mx.google.com with ESMTPS id r13-20020a170906350d00b0098f99048058si9859218eja.1015.2023.08.09.13.23.34 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 09 Aug 2023 13:23:34 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) client-ip=2620:52:3:1:0:246e:9693:128c; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=IYBEp2I6; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c 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 258F43882649 for ; Wed, 9 Aug 2023 20:22:25 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 258F43882649 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1691612545; bh=roXJLX87D3PEziMM+T/4FjCL7spMw/L5ANJUPDiurWE=; h=To:Subject:Date:In-Reply-To:References:List-Id:List-Unsubscribe: List-Archive:List-Post:List-Help:List-Subscribe:From:Reply-To: From; b=IYBEp2I6JToLjq4MkI9FeTXysmcAXT2kMaIHFG1MfyMV8bcoyMWZGbUIUZHQt+WGI 6Sreoil4J7aecTzXyUoat2Mp4e/JuXSGiMs9LcChyvBRXtRpUaBkONQ0qa5ymqdVrA oO6MiHMoCaW/GSSQtJEfKyCji4xuobYgO7gSdpOU= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from smtp.smtpout.orange.fr (smtp-20.smtpout.orange.fr [80.12.242.20]) by sourceware.org (Postfix) with ESMTPS id BAA30385E01F for ; Wed, 9 Aug 2023 20:21:31 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org BAA30385E01F Received: from cyrano.home ([86.215.161.51]) by smtp.orange.fr with ESMTPA id TpgJquxgNE5mdTpgQq56Ys; Wed, 09 Aug 2023 22:21:30 +0200 X-ME-Helo: cyrano.home X-ME-Auth: bW9yaW4tbWlrYWVsQG9yYW5nZS5mcg== X-ME-Date: Wed, 09 Aug 2023 22:21:30 +0200 X-ME-IP: 86.215.161.51 To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: [PATCH 2/3] fortran: Fix length one character dummy arg type [PR110419] Date: Wed, 9 Aug 2023 22:21:21 +0200 Message-Id: <20230809202122.695376-3-mikael@gcc.gnu.org> X-Mailer: git-send-email 2.40.1 In-Reply-To: <20230809202122.695376-1-mikael@gcc.gnu.org> References: <20230809202122.695376-1-mikael@gcc.gnu.org> MIME-Version: 1.0 X-Spam-Status: No, score=-11.6 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FORGED_SPF_HELO, GIT_PATCH_0, JMQ_SPF_NEUTRAL, RCVD_IN_DNSWL_NONE, RCVD_IN_MSPIKE_H4, RCVD_IN_MSPIKE_WL, SPF_HELO_PASS, SPF_NEUTRAL, TXREP autolearn=unavailable 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: Mikael Morin via Gcc-patches From: Mikael Morin Reply-To: Mikael Morin Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: INBOX X-GMAIL-THRID: 1773784388861253099 X-GMAIL-MSGID: 1773784388861253099 Revision r14-2171-g8736d6b14a4dfdfb58c80ccd398981b0fb5d00aa changed the argument passing convention for length 1 value dummy arguments to pass just the single character by value. However, the procedure declarations weren't updated to reflect the change in the argument types. This change does the missing argument type update. The change of argument types generated an internal error in gfc_conv_string_parameter with value_9.f90. Indeed, that function is not prepared for bare character type, so it is updated as well. The condition guarding the single character argument passing code is loosened to not exclude non-interoperable kind (this fixes a regression with c_char_tests_2.f03). Finally, the constant string argument passing code is updated as well to extract the single char and pass it instead of passing it as a length one string. As the code taking care of non-constant arguments was already doing this, the condition guarding it is just removed. With these changes, value_9.f90 passes on 32 bits big-endian powerpc. PR fortran/110360 PR fortran/110419 gcc/fortran/ChangeLog: * trans-types.cc (gfc_sym_type): Use a bare character type for length one value character dummy arguments. * trans-expr.cc (gfc_conv_string_parameter): Handle single character case. (gfc_conv_procedure_call): Don't exclude interoperable kinds from single character handling. For single character dummy arguments, extend the existing handling of non-constant expressions to constant expressions. gcc/testsuite/ChangeLog: * gfortran.dg/bind_c_usage_13.f03: Update tree dump patterns. --- gcc/fortran/trans-expr.cc | 35 +++++++++++-------- gcc/fortran/trans-types.cc | 5 ++- gcc/testsuite/gfortran.dg/bind_c_usage_13.f03 | 8 ++--- 3 files changed, 28 insertions(+), 20 deletions(-) diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 6da3975f77c..d91cc9da221 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -6451,26 +6451,24 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, /* ABI: actual arguments to CHARACTER(len=1),VALUE dummy arguments are actually passed by value. - Strings are truncated to length 1. - The BIND(C) case is handled elsewhere. */ - if (!fsym->ts.is_c_interop - && gfc_length_one_character_type_p (&fsym->ts)) + Strings are truncated to length 1. */ + if (gfc_length_one_character_type_p (&fsym->ts)) { - if (e->expr_type != EXPR_CONSTANT) - { - tree slen1 = build_int_cst (gfc_charlen_type_node, 1); - gfc_conv_string_parameter (&parmse); - parmse.expr = gfc_string_to_single_character (slen1, - parmse.expr, - e->ts.kind); - /* Truncate resulting string to length 1. */ - parmse.string_length = slen1; - } - else if (e->value.character.length > 1) + if (e->expr_type == EXPR_CONSTANT + && e->value.character.length > 1) { e->value.character.length = 1; gfc_conv_expr (&parmse, e); } + + tree slen1 = build_int_cst (gfc_charlen_type_node, 1); + gfc_conv_string_parameter (&parmse); + parmse.expr + = gfc_string_to_single_character (slen1, + parmse.expr, + e->ts.kind); + /* Truncate resulting string to length 1. */ + parmse.string_length = slen1; } if (fsym->attr.optional @@ -10610,6 +10608,13 @@ gfc_conv_string_parameter (gfc_se * se) { tree type; + if (TREE_CODE (TREE_TYPE (se->expr)) == INTEGER_TYPE + && integer_onep (se->string_length)) + { + se->expr = gfc_build_addr_expr (NULL_TREE, se->expr); + return; + } + if (TREE_CODE (se->expr) == STRING_CST) { type = TREE_TYPE (TREE_TYPE (se->expr)); diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc index 987e3d26c46..084b8c3ae2c 100644 --- a/gcc/fortran/trans-types.cc +++ b/gcc/fortran/trans-types.cc @@ -2313,7 +2313,10 @@ gfc_sym_type (gfc_symbol * sym, bool is_bind_c) && sym->ns->proc_name && sym->ns->proc_name->attr.is_bind_c) || (sym->ts.deferred && (!sym->ts.u.cl - || !sym->ts.u.cl->backend_decl)))) + || !sym->ts.u.cl->backend_decl)) + || (sym->attr.dummy + && sym->attr.value + && gfc_length_one_character_type_p (&sym->ts)))) type = gfc_get_char_type (sym->ts.kind); else type = gfc_typenode_for_spec (&sym->ts, sym->attr.codimension); diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_13.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_13.f03 index 470bd59ed38..3cc9f8e0fe9 100644 --- a/gcc/testsuite/gfortran.dg/bind_c_usage_13.f03 +++ b/gcc/testsuite/gfortran.dg/bind_c_usage_13.f03 @@ -130,9 +130,9 @@ end program test ! { dg-final { scan-tree-dump "multiso .&.v..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1..;" "original" } } ! { dg-final { scan-tree-dump "multiso2 .&.w..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1..;" "original" } } ! -! { dg-final { scan-tree-dump "mult_val ..x., .x., 1, 1.;" "original" } } +! { dg-final { scan-tree-dump "mult_val .120, 120, 1, 1.;" "original" } } ! { dg-final { scan-tree-dump "multiso_val .121, 120.;" "original" } } -! { dg-final { scan-tree-dump "multiso2_val ..z., .x..;" "original" } } +! { dg-final { scan-tree-dump "multiso2_val .122, 120.;" "original" } } ! ! Single argument dump: ! @@ -144,7 +144,7 @@ end program test ! { dg-final { scan-tree-dump "subiso .&.v..1..lb: 1 sz: 1..;" "original" } } ! { dg-final { scan-tree-dump "subiso2 .&.w..1..lb: 1 sz: 1..;" "original" } } ! -! { dg-final { scan-tree-dump "sub_val ..x., 1.;" "original" } } +! { dg-final { scan-tree-dump "sub_val .120, 1.;" "original" } } ! { dg-final { scan-tree-dump "subiso_val .121.;" "original" } } -! { dg-final { scan-tree-dump "subiso2_val ..z..;" "original" } } +! { dg-final { scan-tree-dump "subiso2_val .122.;" "original" } } !