This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, Fortran] PR35721 Fix ASSOCIATE for different strides
- From: Tobias Burnus <burnus at net-b dot de>
- To: gcc-patches <gcc-patches at gcc dot gnu dot org>, "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>
- Date: Fri, 28 Mar 2008 14:09:50 +0100
- Subject: [Patch, Fortran] PR35721 Fix ASSOCIATE for different strides
The following was found by Dick Hendrickson (big kudos to him for
running his big Fortran testsuite and reducing the failing tests!). The
Fortran standard mandates:
"Case (v): If TARGET is present and is an array target, the result is true if
the target associated with POINTER and TARGET have the same shape, are neither
of size zero nor arrays whose elements are zero-sized storage sequences, and
occupy the same storage units in array element order. Otherwise, the result is
false. If POINTER is disassociated, the result is false."
gfortran was failing for:
prt => array(2:1:-2)
associated(ptr, array(2:2:1))
Both the pointer and the array point to the same element (array(2)),
although their strides are different.
Bootstrapped on x86-64-linux and regtested there.
OK for the trunk?
(Has someone a better idea for the variable name? "extent" is
misleading; the real extent would be "upper-lower+1" and not "upper-lower".)
Tobias
2008-03-28 Tobias Burnus <burnus@net-b.de>
PR fortran/35721
* intrinsics/associated.c (associated): Ignore different
stride of pointer vs. target if only one element is referred.
2008-03-28 Tobias Burnus <burnus@net-b.de>
PR fortran/35721
* gfortran.dg/associated_target_2.f90: New.
Index: libgfortran/intrinsics/associated.c
===================================================================
--- libgfortran/intrinsics/associated.c (Revision 133633)
+++ libgfortran/intrinsics/associated.c (Arbeitskopie)
@@ -48,10 +48,12 @@ associated (const gfc_array_void *pointe
rank = GFC_DESCRIPTOR_RANK (pointer);
for (n = 0; n < rank; n++)
{
- if (pointer->dim[n].stride != target->dim[n].stride)
+ long extent;
+ extent = pointer->dim[n].ubound - pointer->dim[n].lbound;
+
+ if (extent != (target->dim[n].ubound - target->dim[n].lbound))
return 0;
- if ((pointer->dim[n].ubound - pointer->dim[n].lbound)
- != (target->dim[n].ubound - target->dim[n].lbound))
+ if (pointer->dim[n].stride != target->dim[n].stride && extent != 0)
return 0;
if (pointer->dim[n].ubound < pointer->dim[n].lbound)
return 0;
Index: gcc/testsuite/gfortran.dg/associated_target_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/associated_target_2.f90 (Revision 0)
+++ gcc/testsuite/gfortran.dg/associated_target_2.f90 (Revision 0)
@@ -0,0 +1,41 @@
+! { dg-do run }
+!
+! PR fortran/35721
+!
+! ASSOCIATED(ptr, trgt) should return true if
+! the same storage units (in the same order)
+! gfortran was returning false if the strips
+! were different but only one (the same!) element
+! was present.
+!
+! Contributed by Dick Hendrickson
+!
+ program try_mg0028
+ implicit none
+ real tda2r(2,3)
+
+ call mg0028(tda2r, 1, 2, 3)
+
+ CONTAINS
+
+ SUBROUTINE MG0028(TDA2R,nf1,nf2,nf3)
+ integer :: nf1,nf2,nf3
+ real, target :: TDA2R(NF2,NF3)
+ real, pointer :: TLA2L(:,:),TLA2L1(:,:)
+ logical LL(4)
+ TLA2L => TDA2R(NF2:NF1:-NF2,NF3:NF1:-NF2)
+ TLA2L1 => TLA2L
+ LL(1) = ASSOCIATED(TLA2L)
+ LL(2) = ASSOCIATED(TLA2L,TLA2L1)
+ LL(3) = ASSOCIATED(TLA2L,TDA2R)
+ LL(4) = ASSOCIATED(TLA2L1,TDA2R(2:2,3:1:-2)) !should be true
+
+ if (any(LL .neqv. (/ .true., .true., .false., .true./))) then
+ print *, LL
+ print *, shape(TLA2L1)
+ print *, shape(TDA2R(2:2,3:1:-2))
+ stop
+ endif
+
+ END SUBROUTINE
+ END PROGRAM