Fortran: formal symbol attributes for intrinsic procedures [PR110288]

gcc/fortran/ChangeLog:

	PR fortran/110288
	* symbol.cc (gfc_copy_formal_args_intr): When deriving the formal
	argument attributes from the actual ones for intrinsic procedure
	calls, take special care of CHARACTER arguments that we do not
	wrongly treat them formally as deferred-length.

gcc/testsuite/ChangeLog:

	PR fortran/110288
	* gfortran.dg/findloc_10.f90: New test.

(cherry picked from commit 3b2c523ae31b68fc3b8363b458a55eec53a44365)

diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 221165d6daccd977c032c4575f4a76e7741702e4..535e8f1399cae99495d87513e298228b1e1d25ea 100644 (file)
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -4725,6 +4725,13 @@ gfc_copy_formal_args_intr (gfc_symbol *dest, gfc_intrinsic_sym *src,
       formal_arg->sym->attr.flavor = FL_VARIABLE;
       formal_arg->sym->attr.dummy = 1;
 
+      /* Do not treat an actual deferred-length character argument wrongly
+        as template for the formal argument.  */
+      if (formal_arg->sym->ts.type == BT_CHARACTER
+         && !(formal_arg->sym->attr.allocatable
+              || formal_arg->sym->attr.pointer))
+       formal_arg->sym->ts.deferred = false;
+
       if (formal_arg->sym->ts.type == BT_CHARACTER)
        formal_arg->sym->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
 

diff --git a/gcc/testsuite/gfortran.dg/findloc_10.f90 b/gcc/testsuite/gfortran.dg/findloc_10.f90
new file mode 100644 (file)
index 0000000..4d5ecd2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/findloc_10.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+! PR fortran/110288 - FINDLOC and deferred-length character arguments
+
+program test
+  character(len=:), allocatable :: array(:)
+  character(len=:), allocatable :: value
+  array = ["bb", "aa"]
+  value = "aa"
+  if (findloc (array, value, dim=1) /= 2) stop 1
+end program test
+
+! { dg-final { scan-tree-dump "_gfortran_findloc2_s1 \\(.*, \\.array, \\.value\\)" "original" } }