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
@@ -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);
new file mode 100644
@@ -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