From: Mikael Morin <mikael@gcc.gnu.org>
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 [thread overview]
Message-ID: <20230809202122.695376-2-mikael@gcc.gnu.org> (raw)
In-Reply-To: <20230809202122.695376-1-mikael@gcc.gnu.org>
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
next prev parent reply other threads:[~2023-08-09 20:21 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-08-09 20:21 [PATCH 0/3] fortran: fix length one character dummy args [PR110419] Mikael Morin
2023-08-09 20:21 ` Mikael Morin [this message]
2023-08-09 20:21 ` [PATCH 2/3] fortran: Fix length one character dummy arg type [PR110419] Mikael Morin
2023-08-09 20:21 ` [PATCH 3/3] testsuite: Use distinct explicit error codes in value_9.f90 Mikael Morin
2023-08-13 21:16 ` [PATCH 0/3] fortran: fix length one character dummy args [PR110419] Harald Anlauf
2023-08-14 19:47 ` Mikael Morin
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20230809202122.695376-2-mikael@gcc.gnu.org \
--to=mikael@gcc.gnu.org \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).