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!
14MODULE M
15    INTEGER, PRIVATE :: i
16    REAL :: arraym(5) = (/ (i+0.0, i = 1,5) /)
17CONTAINS
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
30END MODULE M
31
32ELEMENTAL 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)
38END FUNCTION Peter
39
40PROGRAM 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
101CONTAINS
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
165END PROGRAM Main
166
167! { dg-final { cleanup-tree-dump "original" } }
168