diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2023-06-24 20:36:53 +0200 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2023-06-24 20:36:53 +0200 |
| commit | 3f97d10aa1ff5984d6fd657f246d3f251b254ff1 (patch) | |
| tree | e6d8b4991ce3679fcd78060269bbeed0621e8cb2 | |
| parent | 95a2e5328e5aa15724ab8da4aa622a0bfc40c9e5 (diff) | |
Fortran: ABI for scalar CHARACTER(LEN=1),VALUE dummy argument [PR110360]
gcc/fortran/ChangeLog:
PR fortran/110360
* trans-expr.cc (gfc_conv_procedure_call): Truncate constant string
argument of length > 1 passed to scalar CHARACTER(1),VALUE dummy.
| -rw-r--r-- | gcc/fortran/trans-expr.cc | 21 |
1 files changed, 13 insertions, 8 deletions
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index c92fccd0be2..63e3cf9681e 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -6395,20 +6395,25 @@ 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. - The BIND(C) case is handled elsewhere. - TODO: truncate constant strings to length 1. */ + Constant 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) - && e->expr_type != EXPR_CONSTANT) + (fsym->ts.u.cl->length->value.integer, 1) == 0)) { - parmse.expr = gfc_string_to_single_character - (build_int_cst (gfc_charlen_type_node, 1), - parmse.expr, - e->ts.kind); + if (e->expr_type != EXPR_CONSTANT) + parmse.expr = gfc_string_to_single_character + (build_int_cst (gfc_charlen_type_node, 1), + parmse.expr, + e->ts.kind); + else if (e->value.character.length > 1) + { + e->value.character.length = 1; + gfc_conv_expr (&parmse, e); + } } if (fsym->attr.optional |