On 9/1/26 1:14 PM, Jerry D wrote:
On 9/1/26 9:01 AM, Jerry D wrote:
On 9/1/26 6:38 AM, Mikael Morin wrote:
Le 01/09/2026 à 00:14, Jerry DeLisle a écrit :
--- snip ---
You didn't do anything for this, did you?
Anyway, the patch is good enough, so OK to push. I'll open a new PR for
this. I think the runtime span check can be avoided, and the span_only
business as well.
Let me dig on this some more. It is not so obvious how to do this. I will get
back to you if I can figure it out. (Obviously it would be preferred to avoid
any runtime cycles)
Jerry
OK, I did some digging today. It turns out that Mikael is correct, the runtime
check can be avoided. However, to do so I need to commit another patch I have
for PR126950. That patch contains pieces I need to fix 126964 in a better way.
While digging, I also identified another problem that requires a change in
libgfortran.
I will submit the fix for 126950 and the library fix seprately before
resubmitting v3 of this fix.
Thanks for the sharp reviews Mikael.
Best regards,
Jerry
See attached patch. This patch is Part 1 of 2. This patch needs to be applied
before Part 2 of 2 which will be v3 of the patch I submitted earlier. I will
follow this email with the Part 2 shortly.
Regression tested on x86_64.
OK for mainline?
Regards,
Jerry
---
libgfortran: [PR126964] Compare the elements a descriptor denotes in
ASSOCIATED
The stride of a descriptor counts spans rather than elements, so two
descriptors can denote the same storage sequence while holding different
combinations of the two. Elements that are subobjects of larger ones are
described either by the spacing of the larger objects as the span, with the
stride counting them, or by that spacing folded into the stride, with the
element length as the span. ASSOCIATED compared the span and the strides
field by field, so a pointer to a dummy whose spacing is folded into its
strides on entry was not associated with its own actual argument.
Compare the stride in bytes, which is what the two encodings have in
common. The element length is normally held by the dtype, but the
descriptor built for a polymorphic pointer to a character section holds
the spacing there instead and carries the length separately, so require
the two to agree on the element length or on the span rather than on the
element length alone.
PR fortran/126964
libgfortran/ChangeLog:
* intrinsics/associated.c (stride_in_bytes): New function.
(associated): Require the element length or the span to agree
rather than the span alone, and compare the stride in bytes
rather than the stride.
gcc/testsuite/ChangeLog:
* gfortran.dg/associated_target_9.f90: New test.
---commit 5445c3393d2329288464a59bc9cebf3e18735434
Author: Jerry DeLisle <[email protected]>
Date: Tue Sep 1 10:50:00 2026 -0700
libgfortran: [PR126964] Compare the elements a descriptor denotes in ASSOCIATED
The stride of a descriptor counts spans rather than elements, so two
descriptors can denote the same storage sequence while holding different
combinations of the two. Elements that are subobjects of larger ones are
described either by the spacing of the larger objects as the span, with the
stride counting them, or by that spacing folded into the stride, with the
element length as the span. ASSOCIATED compared the span and the strides
field by field, so a pointer to a dummy whose spacing is folded into its
strides on entry was not associated with its own actual argument.
Compare the stride in bytes, which is what the two encodings have in
common. The element length is normally held by the dtype, but the
descriptor built for a polymorphic pointer to a character section holds
the spacing there instead and carries the length separately, so require
the two to agree on the element length or on the span rather than on the
element length alone.
PR fortran/126964
libgfortran/ChangeLog:
* intrinsics/associated.c (stride_in_bytes): New function.
(associated): Require the element length or the span to agree
rather than the span alone, and compare the stride in bytes
rather than the stride.
gcc/testsuite/ChangeLog:
* gfortran.dg/associated_target_9.f90: New test.
diff --git a/gcc/testsuite/gfortran.dg/associated_target_9.f90 b/gcc/testsuite/gfortran.dg/associated_target_9.f90
new file mode 100644
index 00000000000..7b981544016
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associated_target_9.f90
@@ -0,0 +1,70 @@
+! { dg-do run }
+! PR126964
+! Elements that are subobjects of larger ones are described either by the
+! spacing of the larger objects as the span of the descriptor, or by that
+! spacing folded into its strides with the element length as the span.
+! ASSOCIATED compared the two encodings field by field, so a pointer to a
+! TARGET assumed-shape dummy was not associated with the actual argument.
+!
+module m
+ implicit none
+ type :: tr
+ real :: a, b, c
+ end type
+ type :: tc
+ complex :: z
+ real :: r
+ end type
+ real, pointer :: pr(:) => null()
+ real, pointer :: ps(:) => null()
+ complex, pointer :: pc(:) => null()
+contains
+ subroutine taker (x)
+ real, target, intent(inout) :: x(:)
+ pr => x
+ ps => x(1:size (x):2)
+ end subroutine
+ subroutine takec (x)
+ complex, target, intent(inout) :: x(:)
+ pc => x
+ end subroutine
+end module
+
+program p
+ use m
+ implicit none
+ type(tr), target :: v(4)
+ type(tc), target :: w(4)
+ real, target :: flat(4)
+ integer :: i
+
+ v%a = 0.0
+ v%b = [(real (i), i = 1, 4)]
+ v%c = 0.0
+ w%z = [(cmplx (i, 0), i = 1, 4)]
+ w%r = 0.0
+ flat = [(real (i), i = 1, 4)]
+
+ ! Elements that are subobjects of larger ones.
+ call taker (v%b)
+ if (.not. associated (pr, v%b)) stop 1
+ if (.not. associated (ps, v(1:3:2)%b)) stop 2
+
+ ! Contiguous actual argument.
+ call taker (flat)
+ if (.not. associated (pr, flat)) stop 3
+ if (.not. associated (ps, flat(1:3:2))) stop 4
+
+ ! A type whose element length need not divide the spacing.
+ call takec (w%z)
+ if (.not. associated (pc, w%z)) stop 5
+
+ ! Storage sequences that differ are still not associated.
+ call taker (v%b)
+ if (associated (pr, v(1:2)%b)) stop 6
+ if (associated (pr, v(2:4)%b)) stop 7
+ if (associated (pr, v%a)) stop 8
+ if (associated (ps, v%b)) stop 9
+ if (associated (ps, v(2:4:2)%b)) stop 10
+ if (associated (pr, flat)) stop 11
+end program
diff --git a/libgfortran/intrinsics/associated.c b/libgfortran/intrinsics/associated.c
index fecc1b3a283..5787d1c57e4 100644
--- a/libgfortran/intrinsics/associated.c
+++ b/libgfortran/intrinsics/associated.c
@@ -28,6 +28,25 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
extern int associated (const gfc_array_void *, const gfc_array_void *);
export_proto(associated);
+/* Return the spacing in bytes of the elements of DESC in dimension N. The
+ stride counts spans rather than elements, so descriptors that denote the
+ same storage sequence can hold different combinations of the two: elements
+ that are subobjects of larger ones are described either by the spacing of
+ the larger objects as the span, or by that spacing folded into the stride
+ with the element length as the span. The product is what the two have in
+ common. */
+
+static inline index_type
+stride_in_bytes (const gfc_array_void *desc, int n)
+{
+ index_type span = GFC_DESCRIPTOR_SPAN (desc);
+
+ if (span == 0)
+ span = GFC_DESCRIPTOR_SIZE (desc);
+
+ return GFC_DESCRIPTOR_STRIDE (desc, n) * span;
+}
+
int
associated (const gfc_array_void *pointer, const gfc_array_void *target)
{
@@ -37,7 +56,13 @@ associated (const gfc_array_void *pointer, const gfc_array_void *target)
return 0;
if (GFC_DESCRIPTOR_DATA (pointer) != GFC_DESCRIPTOR_DATA (target))
return 0;
- if (GFC_DESCRIPTOR_SPAN (pointer) != GFC_DESCRIPTOR_SPAN (target))
+ /* The element length is normally held by the dtype, but the descriptor
+ built for a polymorphic pointer to a character section holds the
+ spacing of the elements there instead, and carries the length
+ separately. Require the two to agree on one or the other: if they
+ agree on neither, the storage sequences differ. */
+ if (GFC_DESCRIPTOR_SIZE (pointer) != GFC_DESCRIPTOR_SIZE (target)
+ && GFC_DESCRIPTOR_SPAN (pointer) != GFC_DESCRIPTOR_SPAN (target))
return 0;
if (GFC_DESCRIPTOR_DTYPE (pointer).type != GFC_DESCRIPTOR_DTYPE (target).type)
return 0;
@@ -51,7 +76,8 @@ associated (const gfc_array_void *pointer, const gfc_array_void *target)
if (extent != GFC_DESCRIPTOR_EXTENT(target,n))
return 0;
- if (GFC_DESCRIPTOR_STRIDE(pointer,n) != GFC_DESCRIPTOR_STRIDE(target,n) && extent != 1)
+ if (stride_in_bytes (pointer, n) != stride_in_bytes (target, n)
+ && extent != 1)
return 0;
if (extent <= 0)
return 0;
