gcc/testsuite/gfortran.dg/elemental_dependency_4.f90

   1 ! { dg-do run }
   2 ! { dg-additional-options "-fdump-tree-original" }
   3 !
   4 ! Tests the fix for PR64952, in which the assignment to 'array' should
   5 ! have generated a temporary because of the references to the lhs in
   6 ! the function 'Fred'.
   7 !
   8 ! Original report, involving function 'Nick'
   9 ! Contributed by Nick Maclaren  <nmm1@cam.ac.uk> on clf
  10 ! https://groups.google.com/forum/#!topic/comp.lang.fortran/TvVY5j3GPmg
  11 !
  12 ! Other tests are due to Mikael Morin  <mikael.morin@sfr.fr>
  13 !
  14 MODULE M
  15     INTEGER, PRIVATE :: i
  16     REAL :: arraym(5) = (/ (i+0.0, i = 1,5) /)
  17 CONTAINS
  18     ELEMENTAL FUNCTION Bill (n, x)
  19         REAL :: Bill
  20         INTEGER, INTENT(IN) :: n
  21         REAL, INTENT(IN) :: x
  22         Bill = x+SUM(arraym(:n-1))+SUM(arraym(n+1:))
  23     END FUNCTION Bill
  24
  25     ELEMENTAL FUNCTION Charles (x)
  26         REAL :: Charles
  27         REAL, INTENT(IN) :: x
  28         Charles = x
  29     END FUNCTION Charles
  30 END MODULE M
  31
  32 ELEMENTAL FUNCTION Peter(n, x)
  33     USE M
  34     REAL :: Peter
  35     INTEGER, INTENT(IN) :: n
  36     REAL, INTENT(IN) :: x
  37     Peter = Bill(n, x)
  38 END FUNCTION Peter
  39
  40 PROGRAM Main
  41     use M
  42     INTEGER :: i, index(5) = (/ (i, i = 1,5) /)
  43     REAL :: array(5) = (/ (i+0.0, i = 1,5) /)
  44
  45     INTERFACE
  46         ELEMENTAL FUNCTION Peter(n, x)
  47             REAL :: Peter
  48             INTEGER, INTENT(IN) :: n
  49             REAL, INTENT(IN) :: x
  50         END FUNCTION Peter
  51     END INTERFACE
  52
  53     PROCEDURE(Robert2), POINTER :: missme => Null()
  54
  55     ! Original testcase
  56     array = Nick(index,array)
  57     If (any (array .ne. array(1))) call abort
  58
  59     array = (/ (i+0.0, i = 1,5) /)
  60     ! This should not create a temporary
  61     array = Charles(array)
  62     If (any (array .ne. index)) call abort
  63     ! { dg-final { scan-tree-dump-times "array\\\[\[^\\\]\]*\\\]\\s*=\\s*charles\\s*\\(&array\\\[\[^\\\]\]*\\\]\\);" 1 "original" } }
  64
  65     ! Check use association of the function works correctly.
  66     arraym = Bill(index,arraym)
  67     if (any (arraym .ne. arraym(1))) call abort
  68
  69     ! Check siblings interact correctly.
  70     array = (/ (i+0.0, i = 1,5) /)
  71     array = Henry(index)
  72     if (any (array .ne. array(1))) call abort
  73
  74     array = (/ (i+0.0, i = 1,5) /)
  75     ! This should not create a temporary
  76     array = index + Henry2(0) - array
  77     ! { dg-final { scan-tree-dump-times "array\\\[\[^\\\]\]*\\\]\\s*=\\s*\\(\\(real\\(kind=4\\)\\)\\s*index\\\[\[^\\\]\]*\\\]\\s*\\+\\s*D.\\d*\\)\\s*-\\s*array\\\[\[^\\\]\]*\\\];" 1 "original" } }
  78     if (any (array .ne. 15.0)) call abort
  79
  80     arraym = (/ (i+0.0, i = 1,5) /)
  81     arraym = Peter(index, arraym)
  82     if (any (arraym .ne. 15.0)) call abort
  83
  84     array = (/ (i+0.0, i = 1,5) /)
  85     array = Robert(index)
  86     if (any (arraym .ne. 15.0)) call abort
  87
  88     missme => Robert2
  89     array = (/ (i+0.0, i = 1,5) /)
  90     array = David(index)
  91     if (any (arraym .ne. 15.0)) call abort
  92
  93     array = (/ (i+0.0, i = 1,5) /)
  94     array = James(index)
  95     if (any (arraym .ne. 15.0)) call abort
  96
  97     array = (/ (i+0.0, i = 1,5) /)
  98     array = Romeo(index)
  99     if (any (arraym .ne. 15.0)) call abort
 100
 101 CONTAINS
 102     ELEMENTAL FUNCTION Nick (n, x)
 103         REAL :: Nick
 104         INTEGER, INTENT(IN) :: n
 105         REAL, INTENT(IN) :: x
 106         Nick = x+SUM(array(:n-1))+SUM(array(n+1:))
 107     END FUNCTION Nick
 108
 109 ! Note that the inverse order of Henry and Henry2 is trivial.
 110 ! This way round, Henry2 has to be resolved before Henry can
 111 ! be marked as having an inherited external array reference.
 112     ELEMENTAL FUNCTION Henry2 (n)
 113         REAL :: Henry2
 114         INTEGER, INTENT(IN) :: n
 115         Henry2 = n + SUM(array(:n-1))+SUM(array(n+1:))
 116     END FUNCTION Henry2
 117
 118     ELEMENTAL FUNCTION Henry (n)
 119         REAL :: Henry
 120         INTEGER, INTENT(IN) :: n
 121         Henry = Henry2(n)
 122     END FUNCTION Henry
 123
 124     PURE FUNCTION Robert2(n)
 125         REAL :: Robert2
 126         INTEGER, INTENT(IN) :: n
 127         Robert2 = Henry(n)
 128     END FUNCTION Robert2
 129
 130     ELEMENTAL FUNCTION Robert(n)
 131         REAL :: Robert
 132         INTEGER, INTENT(IN) :: n
 133         Robert = Robert2(n)
 134     END FUNCTION Robert
 135
 136     ELEMENTAL FUNCTION David (n)
 137         REAL :: David
 138         INTEGER, INTENT(IN) :: n
 139         David = missme(n)
 140     END FUNCTION David
 141
 142     ELEMENTAL SUBROUTINE James2 (o, i)
 143         REAL, INTENT(OUT) :: o
 144         INTEGER, INTENT(IN) :: i
 145         o = Henry(i)
 146     END SUBROUTINE James2
 147
 148     ELEMENTAL FUNCTION James(n)
 149         REAL :: James
 150         INTEGER, INTENT(IN) :: n
 151         CALL James2(James, n)
 152     END FUNCTION James
 153
 154     FUNCTION Romeo2(n)
 155         REAL :: Romeo2
 156         INTEGER, INTENT(in) :: n
 157         Romeo2 = Henry(n)
 158     END FUNCTION Romeo2
 159
 160     IMPURE ELEMENTAL FUNCTION Romeo(n)
 161         REAL :: Romeo
 162         INTEGER, INTENT(IN) :: n
 163         Romeo = Romeo2(n)
 164     END FUNCTION Romeo
 165 END PROGRAM Main
 166