https://gcc.gnu.org/bugzilla/show_bug.cgi?id=116196

--- Comment #2 from Mikael Morin <mikael at gcc dot gnu.org> ---
More complete testcase:

! { dg-do run }
! { dg-additional-options "-fdump-tree-original" }
!
! PR fortran/116196

MODULE m
  IMPLICIT NONE
  INTEGER, TARGET :: arr(5)
END MODULE m

PROGRAM main
  USE m
  IMPLICIT NONE

  arr = (/ 1, 2, 3, 4, 5 /)
  CALL bar(arr)
  PRINT *, arr
  IF (ANY(arr /= (/ 1, -1, -1, 4, 5 /))) STOP 9

  arr = (/ 1, 2, 3, 4, 5 /)
  CALL bar2(arr)
  PRINT *, arr
  IF (ANY(arr /= (/ 1, -1, -1, 4, 5 /))) STOP 16

  CALL bar3((/ 1, 2, 3, 4, 5 /))
  PRINT *, arr
  IF (ANY(arr /= (/ 1, -1, -1, 4, 5 /))) STOP 23
CONTAINS
  SUBROUTINE bar(x)
    INTEGER :: x(:)
    ! Per WHERE rules, the change of X should not affect the value
    ! of the WHERE mask as the mask is evaluated before.
    WHERE (arr(1:size(x)-1) < 3) x(2:5) = -1
  END SUBROUTINE bar
  SUBROUTINE bar2(x)
    INTEGER, TARGET :: x(:)
    ! As X is TARGET, the change of ARR is allowed to affect the value of X.
    ! Still, per WHERE rules, the change of ARR does not affect the value
    ! of the WHERE mask as the mask is evaluated before.
    WHERE (x(1:size(x)-1) < 3) arr(2:5) = -1
  END SUBROUTINE bar2
  SUBROUTINE bar3(x)
    INTEGER :: x(:)
    ! As X isn't TARGET, we know that the change of ARR is not allowed to
affect
    ! the value of X.  So the WHERE mask can be evaluated on the fly, without
    ! any temporary.
    WHERE (x(1:size(x)-1) < 3) arr(2:5) = -1
  END SUBROUTINE bar3
END PROGRAM main

! Three bar functions, two using a temporary, one temporary-free.
! { dg-final { scan-tree-dump-times "__builtin_malloc" 2 "original" } }

! No memory leak
! { dg-final { scan-tree-dump-times "__builtin_free" 2 "original" } }

Reply via email to