From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from smtp.smtpout.orange.fr (smtp-20.smtpout.orange.fr [80.12.242.20]) by sourceware.org (Postfix) with ESMTPS id B85C6385E017 for ; Wed, 9 Aug 2023 20:21:31 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org B85C6385E017 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=gcc.gnu.org Authentication-Results: sourceware.org; spf=fail smtp.mailfrom=gcc.gnu.org Received: from cyrano.home ([86.215.161.51]) by smtp.orange.fr with ESMTPA id TpgJquxgNE5mdTpgQq56Ys; Wed, 09 Aug 2023 22:21:30 +0200 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=wanadoo.fr; s=t20230301; t=1691612490; bh=roXJLX87D3PEziMM+T/4FjCL7spMw/L5ANJUPDiurWE=; h=From:To:Subject:Date:In-Reply-To:References; b=GhEb59YZUfrfeluURlZtMCPZ1m3ZsH4JdnGrzat5Jgax8JbG6k/53e7dQpuCZFq6b iRWxWXFdcX4bChPu/PAtiHj0JbtgyP9pxMMi6Y3DOi7Roo1NKkmgywLkbiN1kd8Kao RYgpY1ujFMpqUqgjSJB5OH5UBxYLlSj5vYs7+qpSrUYOwgrRRkt+xsxrBFfM/Mj1Sm byFQT9aOya3+d888qsfmfEueYFUPUGfezS5xCAE/sEw9RXOatjT9hy8ONUc3czqA5f jQRLNIGJSC7vzq2xeaN7GEdeBUoz9UJheZ1eg71ORs5qflWm3S5Rc7Kn56vrE3oIm8 tLnXKuNB1Rrsw== 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 From: Mikael Morin 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 Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-11.7 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=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: 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" } } ! -- 2.40.1