1! { dg-do compile } 2! { dg-options "-Warray-temporaries -O -fdump-tree-original" } 3! 4! PR fortran/43829 5! Scalarization of reductions. 6! Test that sum is properly inlined. 7 8! This is the compile time test only; for the runtime test see inline_sum_2.f90 9! We can't test for temporaries on the run time test directly, as it tries 10! several optimization options among which -Os, and sum inlining is disabled 11! at -Os. 12 13 14 implicit none 15 16 17 integer :: i, j, k 18 19 integer, parameter :: q = 2 20 integer, parameter :: nx=3, ny=2*q, nz=5 21 integer, parameter, dimension(nx,ny,nz) :: p = & 22 & reshape ((/ (i**2, i=1,size(p)) /), shape(p)) 23 24 integer, parameter, dimension( ny,nz) :: px = & 25 & reshape ((/ (( & 26 & nx*( nx*j+nx*ny*k+1)*( nx*j+nx*ny*k+1+ (nx-1)) & 27 & + nx*(nx-1)*(2*nx-1)/6, & 28 & j=0,ny-1), k=0,nz-1) /), shape(px)) 29 30 integer, parameter, dimension(nx, nz) :: py = & 31 & reshape ((/ (( & 32 & ny*(i +nx*ny*k+1)*(i +nx*ny*k+1+nx *(ny-1)) & 33 & +(nx )**2*ny*(ny-1)*(2*ny-1)/6, & 34 & i=0,nx-1), k=0,nz-1) /), shape(py)) 35 36 integer, parameter, dimension(nx,ny ) :: pz = & 37 & reshape ((/ (( & 38 & nz*(i+nx*j +1)*(i+nx*j +1+nx*ny*(nz-1)) & 39 & +(nx*ny)**2*nz*(nz-1)*(2*nz-1)/6, & 40 & i=0,nx-1), j=0,ny-1) /), shape(pz)) 41 42 43 integer, dimension(nx,ny,nz) :: a 44 integer, dimension( ny,nz) :: ax 45 integer, dimension(nx, nz) :: ay 46 integer, dimension(nx,ny ) :: az 47 48 logical, dimension(nx,ny,nz) :: m, true 49 50 51 integer, dimension(nx,ny) :: b 52 53 integer, dimension(nx,nx) :: onesx 54 integer, dimension(ny,ny) :: onesy 55 integer, dimension(nz,nz) :: onesz 56 57 58 a = p 59 m = reshape((/ ((/ .true., .false. /), i=1,size(m)/2) /), shape(m)) 60 true = reshape((/ (.true., i=1,size(true)) /), shape(true)) 61 62 onesx = reshape((/ ((1, j=1,i),(0,j=1,nx-i),i=1,size(onesx,2)) /), shape(onesx)) 63 onesy = reshape((/ ((1, j=1,i),(0,j=1,ny-i),i=1,size(onesy,2)) /), shape(onesy)) 64 onesz = reshape((/ ((1, j=1,i),(0,j=1,nz-i),i=1,size(onesz,2)) /), shape(onesz)) 65 66 ! Correct results in simple cases 67 ax = sum(a,1) 68 if (any(ax /= px)) call abort 69 70 ay = sum(a,2) 71 if (any(ay /= py)) call abort 72 73 az = sum(a,3) 74 if (any(az /= pz)) call abort 75 76 77 ! Masks work 78 if (any(sum(a,1,.false.) /= 0)) call abort 79 if (any(sum(a,2,.true.) /= py)) call abort 80 if (any(sum(a,3,m) /= merge(pz,0,m(:,:,1)))) call abort 81 if (any(sum(a,2,m) /= merge(sum(a(:, ::2,:),2),& 82 sum(a(:,2::2,:),2),& 83 m(:,1,:)))) call abort 84 85 86 ! It works too with array constructors ... 87 if (any(sum( & 88 reshape((/ (i*i,i=1,size(a)) /), shape(a)), & 89 1, & 90 true) /= ax)) call abort 91 92 ! ... and with vector subscripts 93 if (any(sum( & 94 a((/ (i,i=1,nx) /), & 95 (/ (i,i=1,ny) /), & 96 (/ (i,i=1,nz) /)), & 97 1) /= ax)) call abort 98 99 if (any(sum( & 100 a(sum(onesx(:,:),1), & ! unnecessary { dg-warning "Creating array temporary" } 101 sum(onesy(:,:),1), & ! unnecessary { dg-warning "Creating array temporary" } 102 sum(onesz(:,:),1)), & ! unnecessary { dg-warning "Creating array temporary" } 103 1) /= ax)) call abort 104 105 106 ! Nested sums work 107 if (sum(sum(sum(a,1),1),1) /= sum(a)) call abort 108 if (sum(sum(sum(a,1),2),1) /= sum(a)) call abort 109 if (sum(sum(sum(a,3),1),1) /= sum(a)) call abort 110 if (sum(sum(sum(a,3),2),1) /= sum(a)) call abort 111 112 if (any(sum(sum(a,1),1) /= sum(sum(a,2),1))) call abort 113 if (any(sum(sum(a,1),2) /= sum(sum(a,3),1))) call abort 114 if (any(sum(sum(a,2),2) /= sum(sum(a,3),2))) call abort 115 116 117 ! Temps are unavoidable here (function call's argument or result) 118 ax = sum(neid3(a),1) ! { dg-warning "Creating array temporary" } 119 ! Sums as part of a bigger expr work 120 if (any(1+sum(eid(a),1)+ax+sum( & 121 neid3(a), & ! { dg-warning "Creating array temporary" } 122 1)+1 /= 3*ax+2)) call abort 123 if (any(1+eid(sum(a,2))+ay+ & 124 neid2( & ! { dg-warning "Creating array temporary" } 125 sum(a,2) & ! { dg-warning "Creating array temporary" } 126 )+1 /= 3*ay+2)) call abort 127 if (any(sum(eid(sum(a,3))+az+2* & 128 neid2(az) & ! { dg-warning "Creating array temporary" } 129 ,1)+1 /= 4*sum(az,1)+1)) call abort 130 131 if (any(sum(transpose(sum(a,1)),1)+sum(az,1) /= sum(ax,2)+sum(sum(a,3),1))) call abort 132 133 134 ! Creates a temp when needed. 135 a(1,:,:) = sum(a,1) ! unnecessary { dg-warning "Creating array temporary" } 136 if (any(a(1,:,:) /= ax)) call abort 137 138 b = p(:,:,1) 139 call set(b(2:,1), sum(b(:nx-1,:),2)) ! { dg-warning "Creating array temporary" } 140 if (any(b(2:,1) /= ay(1:nx-1,1))) call abort 141 142 b = p(:,:,1) 143 call set(b(:,1), sum(b,2)) ! unnecessary { dg-warning "Creating array temporary" } 144 if (any(b(:,1) /= ay(:,1))) call abort 145 146 b = p(:,:,1) 147 call tes(sum(eid(b(:nx-1,:)),2), b(2:,1)) ! { dg-warning "Creating array temporary" } 148 if (any(b(2:,1) /= ay(1:nx-1,1))) call abort 149 150 b = p(:,:,1) 151 call tes(eid(sum(b,2)), b(:,1)) ! unnecessary { dg-warning "Creating array temporary" } 152 if (any(b(:,1) /= ay(:,1))) call abort 153 154contains 155 156 elemental function eid (x) 157 integer, intent(in) :: x 158 integer :: eid 159 160 eid = x 161 end function eid 162 163 function neid2 (x) 164 integer, intent(in) :: x(:,:) 165 integer :: neid2(size(x,1),size(x,2)) 166 167 neid2 = x 168 end function neid2 169 170 function neid3 (x) 171 integer, intent(in) :: x(:,:,:) 172 integer :: neid3(size(x,1),size(x,2),size(x,3)) 173 174 neid3 = x 175 end function neid3 176 177 elemental subroutine set (o, i) 178 integer, intent(in) :: i 179 integer, intent(out) :: o 180 181 o = i 182 end subroutine set 183 184 elemental subroutine tes (i, o) 185 integer, intent(in) :: i 186 integer, intent(out) :: o 187 188 o = i 189 end subroutine tes 190end 191! { dg-final { scan-tree-dump-times "struct array._integer\\(kind=4\\) atmp" 13 "original" } } 192! { dg-final { scan-tree-dump-times "struct array\[^\\n\]*atmp" 13 "original" } } 193! { dg-final { scan-tree-dump-times "_gfortran_sum_" 0 "original" } } 194! { dg-final { cleanup-tree-dump "original" } } 195