diff options
author | Harald Anlauf <anlauf@gmx.de> | 2023-07-11 21:21:25 +0200 |
---|---|---|
committer | Harald Anlauf <anlauf@gmx.de> | 2023-07-11 21:21:25 +0200 |
commit | 3b2c523ae31b68fc3b8363b458a55eec53a44365 (patch) | |
tree | 8617a28272725f934674ee64cbaaa6da86ae9e55 | |
parent | 47bd559829726f44b9c545cd96db49e57f1fd3c4 (diff) | |
download | gcc-3b2c523ae31b68fc3b8363b458a55eec53a44365.zip gcc-3b2c523ae31b68fc3b8363b458a55eec53a44365.tar.gz gcc-3b2c523ae31b68fc3b8363b458a55eec53a44365.tar.bz2 |
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.
-rw-r--r-- | gcc/fortran/symbol.cc | 7 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/findloc_10.f90 | 13 |
2 files changed, 20 insertions, 0 deletions
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc index 37a9e8f..90023f0 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 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" } } |