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 BDD82385E02C for ; Wed, 9 Aug 2023 20:21:31 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org BDD82385E02C 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 TpgJquxgNE5mdTpgQq56Yq; 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=bEOGboPTZeLZPH3V3a3fo1Iu+qywHXPkfjc/aFsYHuc=; h=From:To:Subject:Date:In-Reply-To:References; b=kQnLTCBCyvJCltZPrINI0I1JeUg5tsudvqjukEeS8jZpWxr3EXi5yNa8FOne5O+F0 qtWC2dX7Tfj/ongHD25N+vpsUm/nEomP3GYk8HcQ1XhCxL4r+mcXxs0vRJdYwCS0s4 vmTTfbOY/QzMTFhtmbDlgKzRtOLm4NpC1ropvIyzITiJCFek3LyM1qFbqJLHQTLWfe 1f/eYR1deKKDahwz+T8KmexmJ3BlwkgQLUTMu5fqK/Nmy/kr86BMZH+OnFE7jLLlnK TNOGw06RKM1HyT0H4XH536zHuIejPCTJ6CmSKNcSL7bwmD+RYMw8+HGrfeVZLF30Io 6Ykb90+gxMSFQ== 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 1/3] fortran: New predicate gfc_length_one_character_type_p Date: Wed, 9 Aug 2023 22:21:20 +0200 Message-Id: <20230809202122.695376-2-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.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 List-Id: Introduce a new predicate to simplify conditionals checking for a character type whose length is the constant one. gcc/fortran/ChangeLog: * gfortran.h (gfc_length_one_character_type_p): New inline function. * check.cc (is_c_interoperable): Use gfc_length_one_character_type_p. * decl.cc (verify_bind_c_sym): Same. * trans-expr.cc (gfc_conv_procedure_call): Same. --- gcc/fortran/check.cc | 7 +++---- gcc/fortran/decl.cc | 4 +--- gcc/fortran/gfortran.h | 15 +++++++++++++++ gcc/fortran/trans-expr.cc | 8 ++------ 4 files changed, 21 insertions(+), 13 deletions(-) diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc index 4086dc71d34..6c45e6542f0 100644 --- a/gcc/fortran/check.cc +++ b/gcc/fortran/check.cc @@ -5250,10 +5250,9 @@ is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc, bool c_f_ptr) && !gfc_simplify_expr (expr->ts.u.cl->length, 0)) gfc_internal_error ("is_c_interoperable(): gfc_simplify_expr failed"); - if (!c_loc && expr->ts.u.cl - && (!expr->ts.u.cl->length - || expr->ts.u.cl->length->expr_type != EXPR_CONSTANT - || mpz_cmp_si (expr->ts.u.cl->length->value.integer, 1) != 0)) + if (!c_loc + && expr->ts.u.cl + && !gfc_length_one_character_type_p (&expr->ts)) { *msg = "Type shall have a character length of 1"; return false; diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index 844345df77e..8182ef29f43 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -6064,9 +6064,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts, /* BIND(C) functions cannot return a character string. */ if (bind_c_function && tmp_sym->ts.type == BT_CHARACTER) - if (tmp_sym->ts.u.cl == NULL || tmp_sym->ts.u.cl->length == NULL - || tmp_sym->ts.u.cl->length->expr_type != EXPR_CONSTANT - || mpz_cmp_si (tmp_sym->ts.u.cl->length->value.integer, 1) != 0) + if (!gfc_length_one_character_type_p (&tmp_sym->ts)) gfc_error ("Return type of BIND(C) function %qs of character " "type at %L must have length 1", tmp_sym->name, &(tmp_sym->declared_at)); diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 6482a885211..d44e5286626 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3181,6 +3181,21 @@ gfc_finalizer; /************************ Function prototypes *************************/ + +/* Returns true if the type specified in TS is a character type whose length + is the constant one. Otherwise returns false. */ + +inline bool +gfc_length_one_character_type_p (gfc_typespec *ts) +{ + return ts->type == BT_CHARACTER + && ts->u.cl + && ts->u.cl->length + && ts->u.cl->length->expr_type == EXPR_CONSTANT + && ts->u.cl->length->ts.type == BT_INTEGER + && mpz_cmp_ui (ts->u.cl->length->value.integer, 1) == 0; +} + /* decl.cc */ bool gfc_in_match_data (void); match gfc_match_char_spec (gfc_typespec *); diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index ef3e6d08f78..6da3975f77c 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -6453,12 +6453,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, dummy arguments are actually passed by value. Strings are truncated to length 1. The BIND(C) case is handled elsewhere. */ - if (fsym->ts.type == BT_CHARACTER - && !fsym->ts.is_c_interop - && fsym->ts.u.cl->length->expr_type == EXPR_CONSTANT - && fsym->ts.u.cl->length->ts.type == BT_INTEGER - && (mpz_cmp_ui - (fsym->ts.u.cl->length->value.integer, 1) == 0)) + if (!fsym->ts.is_c_interop + && gfc_length_one_character_type_p (&fsym->ts)) { if (e->expr_type != EXPR_CONSTANT) { -- 2.40.1