]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Fortran: potential aliasing of complex pointer inquiry references [PR118120]
authorHarald Anlauf <anlauf@gmx.de>
Thu, 19 Dec 2024 21:22:52 +0000 (22:22 +0100)
committerHarald Anlauf <anlauf@gmx.de>
Fri, 20 Dec 2024 17:23:32 +0000 (18:23 +0100)
PR fortran/118120
PR fortran/113928

gcc/fortran/ChangeLog:

* trans-array.cc (symbols_could_alias): If one symbol refers to a
complex type and the other to a real type of the same kind, do not
a priori exclude the possibility of aliasing.

gcc/testsuite/ChangeLog:

* gfortran.dg/aliasing_complex_pointer.f90: New test.

gcc/fortran/trans-array.cc
gcc/testsuite/gfortran.dg/aliasing_complex_pointer.f90 [new file with mode: 0644]

index 82a2ae1f7479f7d72c2aa9fcb2bd31f19f29500b..52813857353fd4139976165e9ed7742c918c55b2 100644 (file)
@@ -5344,15 +5344,20 @@ static bool
 symbols_could_alias (gfc_symbol *lsym, gfc_symbol *rsym, bool lsym_pointer,
                     bool lsym_target, bool rsym_pointer, bool rsym_target)
 {
-  /* Aliasing isn't possible if the symbols have different base types.  */
-  if (gfc_compare_types (&lsym->ts, &rsym->ts) == 0)
-    return 0;
+  /* Aliasing isn't possible if the symbols have different base types,
+     except for complex types where an inquiry reference (%RE, %IM) could
+     alias with a real type with the same kind parameter.  */
+  if (!gfc_compare_types (&lsym->ts, &rsym->ts)
+      && !(((lsym->ts.type == BT_COMPLEX && rsym->ts.type == BT_REAL)
+           || (lsym->ts.type == BT_REAL && rsym->ts.type == BT_COMPLEX))
+          && lsym->ts.kind == rsym->ts.kind))
+    return false;
 
   /* Pointers can point to other pointers and target objects.  */
 
   if ((lsym_pointer && (rsym_pointer || rsym_target))
       || (rsym_pointer && (lsym_pointer || lsym_target)))
-    return 1;
+    return true;
 
   /* Special case: Argument association, cf. F90 12.4.1.6, F2003 12.4.1.7
      and F2008 12.5.2.13 items 3b and 4b. The pointer case (a) is already
@@ -5363,9 +5368,9 @@ symbols_could_alias (gfc_symbol *lsym, gfc_symbol *rsym, bool lsym_pointer,
          || (rsym->attr.dummy && !rsym->attr.contiguous
              && (!rsym->attr.dimension
                  || rsym->as->type == AS_ASSUMED_SHAPE))))
-    return 1;
+    return true;
 
-  return 0;
+  return false;
 }
 
 
diff --git a/gcc/testsuite/gfortran.dg/aliasing_complex_pointer.f90 b/gcc/testsuite/gfortran.dg/aliasing_complex_pointer.f90
new file mode 100644 (file)
index 0000000..7fc4a20
--- /dev/null
@@ -0,0 +1,46 @@
+! { dg-do run }
+! PR fortran/118120 - potential aliasing of complex pointer inquiry references
+!
+! Contributed by Slava Zakharin < szakharin at nvidia dot com >
+
+program main
+  implicit none
+  integer :: k
+  complex, target :: data(21)
+  do k=1,21
+     data(k) = cmplx(-k,0.0)
+  end do
+  call test(1, 1, data)
+! print *, data
+  if (     data(1)      /= -1.)           stop 1
+  if (any (data(2:)% re /= [(k,k=1,20)])) stop 2
+  call pr113928 ()
+contains
+  subroutine test(i, j, data)
+    integer :: i, j
+    complex, target  :: data(21)
+    real, pointer    :: result(:,:,:,:)
+    complex, pointer :: temp(:,:)
+    result(i:i,j:j,1:4,1:5) => data(2:)%re
+    temp(1:4,1:5)           => data(1:20)
+    result(i,j,:,:) = abs(temp)
+  end subroutine test
+end program main
+
+! PR fortran/113928
+!
+! Contributed by < eddyg_61-bugzilla at yahoo dot it >
+
+subroutine pr113928
+  implicit none
+  integer, parameter :: N = 4
+  complex, target    :: wz(N) = 0.
+  real,    pointer   :: wr(:)
+  integer :: i
+
+  wr => wz%re
+  wr = [(i,i=1,N)]
+  wr = wr + wz(N:1:-1)%re
+! print *, wr
+  if (any (wr /= N+1)) stop 3
+end