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
|| (rsym->attr.dummy && !rsym->attr.contiguous
&& (!rsym->attr.dimension
|| rsym->as->type == AS_ASSUMED_SHAPE))))
- return 1;
+ return true;
- return 0;
+ return false;
}
--- /dev/null
+! { 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