From: Harald Anlauf <anlauf@gmx.de>
Date: Tue, 11 Jul 2023 19:21:25 +0000 (+0200)
Subject: Fortran: formal symbol attributes for intrinsic procedures [PR110288]
X-Git-Tag: basepoints/gcc-15~7700
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=3b2c523ae31b68fc3b8363b458a55eec53a44365;p=thirdparty%2Fgcc.git

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.
---

diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 37a9e8fa0aef..90023f0ad73a 100644
--- 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
index 000000000000..4d5ecd2306ac
--- /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" } }