Dear all,
the attached patch fixes a long-standing issue with legacy code,
where an assumed-length character function is passed as actual
argument to a procedure, and when there is no explicit interface.
The solution is to do the same as in the case when there is an
actual interface: take the character length from the actual
argument. Without the patch, we inferred a wrong interface
for the procedure and forgot to pass the character length.
Regtested on x86_64-pc-linux-gnu. OK for mainline / backport?
Thanks,
Harald
From c08305a44c389e7ccaafade6026096e95e865eed Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Tue, 22 Jul 2025 20:16:16 +0200
Subject: [PATCH] Fortran: fix passing of character length of function to
procedure [PR121203]
PR fortran/121203
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_procedure_call): Obtain the character
length of an assumed character length procedure from the typespec
of the actual argument even if there is no explicit interface.
gcc/testsuite/ChangeLog:
* gfortran.dg/function_charlen_4.f90: New test.
---
gcc/fortran/trans-expr.cc | 26 +++++++-------
.../gfortran.dg/function_charlen_4.f90 | 34 +++++++++++++++++++
2 files changed, 47 insertions(+), 13 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/function_charlen_4.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 6fa52d0ffef..7c7621571ad 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7909,21 +7909,21 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
se->ss->info->class_container = arg1_cntnr;
}
- if (fsym && e)
+ /* Obtain the character length of an assumed character length procedure
+ from the typespec of the actual argument. */
+ if (e
+ && parmse.string_length == NULL_TREE
+ && e->ts.type == BT_PROCEDURE
+ && e->symtree->n.sym->ts.type == BT_CHARACTER
+ && e->symtree->n.sym->ts.u.cl->length != NULL
+ && e->symtree->n.sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)
{
- /* Obtain the character length of an assumed character length
- length procedure from the typespec. */
- if (fsym->ts.type == BT_CHARACTER
- && parmse.string_length == NULL_TREE
- && e->ts.type == BT_PROCEDURE
- && e->symtree->n.sym->ts.type == BT_CHARACTER
- && e->symtree->n.sym->ts.u.cl->length != NULL
- && e->symtree->n.sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)
- {
- gfc_conv_const_charlen (e->symtree->n.sym->ts.u.cl);
- parmse.string_length = e->symtree->n.sym->ts.u.cl->backend_decl;
- }
+ gfc_conv_const_charlen (e->symtree->n.sym->ts.u.cl);
+ parmse.string_length = e->symtree->n.sym->ts.u.cl->backend_decl;
+ }
+ if (fsym && e)
+ {
/* Obtain the character length for a NULL() actual with a character
MOLD argument. Otherwise substitute a suitable dummy length.
Here we handle non-optional dummies of non-bind(c) procedures. */
diff --git a/gcc/testsuite/gfortran.dg/function_charlen_4.f90 b/gcc/testsuite/gfortran.dg/function_charlen_4.f90
new file mode 100644
index 00000000000..ed39aca4f42
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/function_charlen_4.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+! { dg-options "-O2 -std=legacy -fdump-tree-optimized" }
+!
+! PR fortran/121203 - fix passing of character length of function to procedure
+
+program p
+ character(10), external :: f
+ call eval (f,"abc")
+ call eval2(f,"abc")
+contains
+ subroutine eval2(func,c_arg)
+ character(*) c_arg
+ character(*) func
+ external func
+ ! These tests should get optimized:
+ if (len (c_arg) /= 3) stop 1
+ if (len (func(c_arg)) /= 10) stop 2
+ end subroutine
+end
+
+character(10) function f(arg)
+ character(*) arg
+ f=arg
+end
+
+subroutine eval(func,c_arg)
+ character(*) c_arg
+ character(*) func
+ external func
+ if (len (c_arg) /= 3) error stop 3
+ if (len (func(c_arg)) /= 10) error stop 4
+end subroutine
+
+! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "optimized" } }
--
2.43.0
