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)
This commit is contained in:
Harald Anlauf 2023-07-11 21:21:25 +02:00
parent ef4b6d29d9
commit 447dd2924e
2 changed files with 20 additions and 0 deletions

View File

@ -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);

View File

@ -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" } }