https://gcc.gnu.org/g:e2438c0dc888f683b6717f5207ae905424cdf6ef
commit e2438c0dc888f683b6717f5207ae905424cdf6ef Author: Mikael Morin <[email protected]> Date: Mon Sep 14 14:19:06 2026 +0200 fortran: Don't check for mismatching spans in ASSOCIATED [PR127233] Remove the check for mismatching spans from the combined mismatching spans and element lengths in the implementation of ASSOCIATED. Indeed, for ASSOCIATED to return true when given two array arguments, a requirement for them is to occupy the same storage units, meaning a mismatch of element lengths alone is sufficient for the function to return false. Despite this change, the spans continue to play a role in the result of ASSOCIATED, as they are used elsewhere in combination with the strides since a recent change [1] to recognize different representations of the same array section as equal. [1] libgfortran: Compare the elements a descriptor denotes in ASSOCIATED https://gcc.gnu.org/r17-3954 PR fortran/127233 libgfortran/ChangeLog: * intrinsics/associated.c (associated): Remove span check from the combined span and element length check. gcc/testsuite/ChangeLog: * gfortran.dg/associated_9.f90: New test. Diff: --- gcc/testsuite/gfortran.dg/associated_9.f90 | 37 ++++++++++++++++++++++++++++++ libgfortran/intrinsics/associated.c | 3 +-- 2 files changed, 38 insertions(+), 2 deletions(-) diff --git a/gcc/testsuite/gfortran.dg/associated_9.f90 b/gcc/testsuite/gfortran.dg/associated_9.f90 new file mode 100644 index 000000000000..309ff57bb9bc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associated_9.f90 @@ -0,0 +1,37 @@ +! { dg-do run } +! +! PR fortran/127233 +! Check that the intrinsic ASSOCIATED takes the span and the storage size +! into account. + +program prog + implicit none + character(len=:), allocatable, target :: c(:) + c = ["abc", "def", "ghi", "jkl", "mno"] + call sc(c, c, .true., 11) + call sc(c(::2), c(::2), .true., 12) + call sc(c(:)(1:2), c(:)(1:2), .true., 13) + call sc(c(::2)(1:2), c(::2)(1:2), .true., 14) + call sc(c(1:5:2), c(1:3), .false., 21) + call sc(c(1:3), c(1:5:2), .false., 22) + call sc(c(:)(1:2), c(:), .false., 23) + call sc(c(:), c(:)(1:2), .false., 24) + call sc(c(1:5:2)(1:2), c(1:3), .false., 25) + call sc(c(1:3), c(1:5:2)(1:2), .false., 26) + call sc(c(1:5:2), c(1:3)(1:2), .false., 27) + call sc(c(1:3)(1:2), c(1:5:2), .false., 28) +contains + subroutine sc(p, t, r, e) + character(len=:), pointer, intent(in) :: p(:) + character(len=*), target, intent(in) :: t(:) + logical, intent(in) :: r + integer, intent(in) :: e + call check(associated(p, t), r, e) + end subroutine + subroutine check(r, v, e) + logical, intent(in) :: r, v + integer, intent(in) :: e + !print *, r, v, (r.eqv.v ? "PASS" : "FAIL"), e + if (r .neqv. v) error stop e + end subroutine +end program diff --git a/libgfortran/intrinsics/associated.c b/libgfortran/intrinsics/associated.c index d9ffddd8055c..836ecdb6e7f5 100644 --- a/libgfortran/intrinsics/associated.c +++ b/libgfortran/intrinsics/associated.c @@ -51,8 +51,7 @@ associated (const gfc_array_void *pointer, const gfc_array_void *target) return 0; /* Require that the storage sequences are the same. */ - if (GFC_DESCRIPTOR_SIZE (pointer) != GFC_DESCRIPTOR_SIZE (target) - && GFC_DESCRIPTOR_SPAN (pointer) != GFC_DESCRIPTOR_SPAN (target)) + if (GFC_DESCRIPTOR_SIZE (pointer) != GFC_DESCRIPTOR_SIZE (target)) return 0; if (GFC_DESCRIPTOR_DTYPE (pointer).type != GFC_DESCRIPTOR_DTYPE (target).type)
