[PATCH] Fortran: formal symbol attributes for intrinsic procedures [PR110288]

[Harald Anlauf <anlauf@gmx.de>]

[-- Attachment #1: Type: text/plain, Size: 882 bytes --]

Dear all,

for intrinsic procedures we derive the typespec of the formal symbol
attributes from the actual arguments.  This can have an undesired
effect for character actual arguments, as the argument passing
conventions differ for deferred-length (length is passed by reference)
and otherwise (length is passed by value).

The testcase in the PR nicely demonstrates the issue for
FINDLOC(array,value,...), when either array or value are deferred-length.

We therefore need take care that we do not copy ts.deferred, but
rather set it to false if the formal argument is neither allocatable
or pointer.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

This is actually a 11/12/13/14 regression (and I found a potential
"culprit" in 11-development that touched the call chain in question),
so the patch might finally need backporting as far as seems reasonable.

Thanks,
Harald


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr110288.diff --]
[-- Type: text/x-patch, Size: 2331 bytes --]

From 3b2c523ae31b68fc3b8363b458a55eec53a44365 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Tue, 11 Jul 2023 21:21:25 +0200
Subject: [PATCH] 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.
---
 gcc/fortran/symbol.cc                    |  7 +++++++
 gcc/testsuite/gfortran.dg/findloc_10.f90 | 13 +++++++++++++
 2 files changed, 20 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/findloc_10.f90

diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 37a9e8fa0ae..90023f0ad73 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 00000000000..4d5ecd2306a
--- /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" } }
--
2.35.3