diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2025-02-06 16:40:19 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2025-02-06 16:40:40 +0000 |
| commit | a03303b4d5b2ca58e5750a4d5bd735d85a091273 (patch) | |
| tree | 83cb4fca99554440083289e1987e16b818e926b3 /gcc | |
| parent | bb9cee8928f7f4dfb94e7a8f232eda736b711450 (diff) | |
| download | gcc-a03303b4d5b2ca58e5750a4d5bd735d85a091273.zip gcc-a03303b4d5b2ca58e5750a4d5bd735d85a091273.tar.gz gcc-a03303b4d5b2ca58e5750a4d5bd735d85a091273.tar.bz2 | |
Fortran: FIx ICE in associate with elemental function [PR118750]
2025-02-06 Paul Thomas <pault@gcc.gnu.org>
gcc/fortran
PR fortran/118750
* resolve.cc (resolve_assoc_var): If the target expression has
a rank, do not use gfc_expression_rank, since it will return 0
if the function is elemental. Resolution will have produced the
correct rank.
gcc/testsuite/
PR fortran/118750
* gfortran.dg/associate_72.f90: New test.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/resolve.cc | 2 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/associate_72.f90 | 26 |
2 files changed, 27 insertions, 1 deletions
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index c9736db..7adbf95 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -10728,7 +10728,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) || gfc_is_ptr_fcn (target)); /* Finally resolve if this is an array or not. */ - if (target->expr_type == EXPR_FUNCTION + if (target->expr_type == EXPR_FUNCTION && target->rank == 0 && (sym->ts.type == BT_CLASS || sym->ts.type == BT_DERIVED)) { gfc_expression_rank (target); diff --git a/gcc/testsuite/gfortran.dg/associate_72.f90 b/gcc/testsuite/gfortran.dg/associate_72.f90 new file mode 100644 index 0000000..993ebdf --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associate_72.f90 @@ -0,0 +1,26 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! Test the fix for the 14/15 regression PR118750 +! +! Contributed by Damian Rouson <damian@archaeologic.codes> +! + implicit none + + type string_t + character(:), allocatable :: str + end type + + associate(str_a => get_string([string_t ("abcd"),string_t ("ef")])) + if (str_a(1)%str//str_a(2)%str /= "abcdef") STOP 1 ! Returned "Invalid array reference at (1)" + end associate + +contains + + type(string_t) elemental function get_string(mold) + class(string_t), intent(in) :: mold + get_string = string_t(mold%str) + end function + +end +! { dg-final { scan-tree-dump-times "array01_string_t str_a" 1 "original" } } |