gcc/testsuite/gfortran.dg/elemental_dependency_4.f90

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