diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc index 4086dc71d340beb8fd0f4cf37f29028f04ba8e06..6c45e6542f04441cf86a4be544ed2f42a04a8be8 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 844345df77e98b6ac49641b47cf876e6fedfc238..8182ef29f43ff06eb822512dd7404279ee8bacca 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 9a00e6dea6f1f91077d2dc8a2c4ce37c79c93788..fd47000a88efd00640ab3d43324f50c0614ddd59 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3182,6 +3182,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 764565476af2dd5db4e81a6fb4e6ded976d40019..9c73b7e478598de460ce05cdae7550b57dc75999 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) {