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.

(cherry picked from commit 53b64337ef325c4e47ae96ea8dea86031a3a0602)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index e4cba5647c307b80c18037af99fa4c86a1ed03a5..08fc524f857889c6b123850e74c2b83eb760c9c4 100644 (file)
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7900,21 +7900,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 (file)
index 0000000..ed39aca
--- /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" } }