gcc/testsuite/gfortran.dg/elemental_dependency_4.f90

! { dg-do run }
! { dg-additional-options "-fdump-tree-original" }
! { dg-require-visibility "" }
!
! Tests the fix for PR64952, in which the assignment to 'array' should
! have generated a temporary because of the references to the lhs in
! the function 'Fred'.
!
! Original report, involving function 'Nick'
! Contributed by Nick Maclaren  <nmm1@cam.ac.uk> on clf
! https://groups.google.com/forum/#!topic/comp.lang.fortran/TvVY5j3GPmg
!
! Other tests are due to Mikael Morin  <mikael.morin@sfr.fr>
!
MODULE M
    INTEGER, PRIVATE :: i
    REAL :: arraym(5) = (/ (i+0.0, i = 1,5) /)
CONTAINS
    ELEMENTAL FUNCTION Bill (n, x)
        REAL :: Bill
        INTEGER, INTENT(IN) :: n
        REAL, INTENT(IN) :: x
        Bill = x+SUM(arraym(:n-1))+SUM(arraym(n+1:))
    END FUNCTION Bill

    ELEMENTAL FUNCTION Charles (x)
        REAL :: Charles
        REAL, INTENT(IN) :: x
        Charles = x
    END FUNCTION Charles
END MODULE M

ELEMENTAL FUNCTION Peter(n, x)
    USE M
    REAL :: Peter
    INTEGER, INTENT(IN) :: n
    REAL, INTENT(IN) :: x
    Peter = Bill(n, x)
END FUNCTION Peter

PROGRAM Main
    use M
    INTEGER :: i, index(5) = (/ (i, i = 1,5) /)
    REAL :: array(5) = (/ (i+0.0, i = 1,5) /)

    INTERFACE
        ELEMENTAL FUNCTION Peter(n, x)
            REAL :: Peter
            INTEGER, INTENT(IN) :: n
            REAL, INTENT(IN) :: x
        END FUNCTION Peter
    END INTERFACE

    PROCEDURE(Robert2), POINTER :: missme => Null()

    ! Original testcase
    array = Nick(index,array)
    If (any (array .ne. array(1))) STOP 1

    array = (/ (i+0.0, i = 1,5) /)
    ! This should not create a temporary
    array = Charles(array)
    If (any (array .ne. index)) STOP 2
    ! { dg-final { scan-tree-dump-times "array\\\[\[^\\\]\]*\\\]\\s*=\\s*charles\\s*\\(&array\\\[\[^\\\]\]*\\\]\\);" 1 "original" } }

    ! Check use association of the function works correctly.
    arraym = Bill(index,arraym)
    if (any (arraym .ne. arraym(1))) STOP 3

    ! Check siblings interact correctly.
    array = (/ (i+0.0, i = 1,5) /)
    array = Henry(index)
    if (any (array .ne. array(1))) STOP 4

    array = (/ (i+0.0, i = 1,5) /)
    ! This should not create a temporary
    array = index + Henry2(0) - array
    ! { dg-final { scan-tree-dump-times "array\\\[\[^\\\]\]*\\\]\\s*=\\s*\\(\\(real\\(kind=4\\)\\)\\s*index\\\[\[^\\\]\]*\\\]\\s*\\+\\s*D.\\d*\\)\\s*-\\s*array\\\[\[^\\\]\]*\\\];" 1 "original" } }
    if (any (array .ne. 15.0)) STOP 5

    arraym = (/ (i+0.0, i = 1,5) /)
    arraym = Peter(index, arraym)
    if (any (arraym .ne. 15.0)) STOP 6

    array = (/ (i+0.0, i = 1,5) /)
    array = Robert(index)
    if (any (arraym .ne. 15.0)) STOP 7

    missme => Robert2
    array = (/ (i+0.0, i = 1,5) /)
    array = David(index)
    if (any (arraym .ne. 15.0)) STOP 8

    array = (/ (i+0.0, i = 1,5) /)
    array = James(index)
    if (any (arraym .ne. 15.0)) STOP 9

    array = (/ (i+0.0, i = 1,5) /)
    array = Romeo(index)
    if (any (arraym .ne. 15.0)) STOP 10

CONTAINS
    ELEMENTAL FUNCTION Nick (n, x)
        REAL :: Nick
        INTEGER, INTENT(IN) :: n
        REAL, INTENT(IN) :: x
        Nick = x+SUM(array(:n-1))+SUM(array(n+1:))
    END FUNCTION Nick

! Note that the inverse order of Henry and Henry2 is trivial.
! This way round, Henry2 has to be resolved before Henry can
! be marked as having an inherited external array reference.
    ELEMENTAL FUNCTION Henry2 (n)
        REAL :: Henry2
        INTEGER, INTENT(IN) :: n
        Henry2 = n + SUM(array(:n-1))+SUM(array(n+1:))
    END FUNCTION Henry2

    ELEMENTAL FUNCTION Henry (n)
        REAL :: Henry
        INTEGER, INTENT(IN) :: n
        Henry = Henry2(n)
    END FUNCTION Henry

    PURE FUNCTION Robert2(n)
        REAL :: Robert2
        INTEGER, INTENT(IN) :: n
        Robert2 = Henry(n)
    END FUNCTION Robert2

    ELEMENTAL FUNCTION Robert(n)
        REAL :: Robert
        INTEGER, INTENT(IN) :: n
        Robert = Robert2(n)
    END FUNCTION Robert

    ELEMENTAL FUNCTION David (n)
        REAL :: David
        INTEGER, INTENT(IN) :: n
        David = missme(n)
    END FUNCTION David

    ELEMENTAL SUBROUTINE James2 (o, i)
        REAL, INTENT(OUT) :: o
        INTEGER, INTENT(IN) :: i
        o = Henry(i)
    END SUBROUTINE James2

    ELEMENTAL FUNCTION James(n)
        REAL :: James
        INTEGER, INTENT(IN) :: n
        CALL James2(James, n)
    END FUNCTION James

    FUNCTION Romeo2(n)
        REAL :: Romeo2
        INTEGER, INTENT(in) :: n
        Romeo2 = Henry(n)
    END FUNCTION Romeo2

    IMPURE ELEMENTAL FUNCTION Romeo(n)
        REAL :: Romeo
        INTEGER, INTENT(IN) :: n
        Romeo = Romeo2(n)
    END FUNCTION Romeo
END PROGRAM Main