! { dg-do compile } ! { dg-options "-Warray-temporaries -O -fdump-tree-original" } ! ! PR fortran/43829 ! Scalarization of reductions. ! Test that sum is properly inlined. ! This is the compile time test only; for the runtime test see inline_sum_2.f90 ! We can't test for temporaries on the run time test directly, as it tries ! several optimization options among which -Os, and sum inlining is disabled ! at -Os. implicit none integer :: i, j, k integer, parameter :: q = 2 integer, parameter :: nx=3, ny=2*q, nz=5 integer, parameter, dimension(nx,ny,nz) :: p = & & reshape ((/ (i**2, i=1,size(p)) /), shape(p)) integer, parameter, dimension( ny,nz) :: px = & & reshape ((/ (( & & nx*( nx*j+nx*ny*k+1)*( nx*j+nx*ny*k+1+ (nx-1)) & & + nx*(nx-1)*(2*nx-1)/6, & & j=0,ny-1), k=0,nz-1) /), shape(px)) integer, parameter, dimension(nx, nz) :: py = & & reshape ((/ (( & & ny*(i +nx*ny*k+1)*(i +nx*ny*k+1+nx *(ny-1)) & & +(nx )**2*ny*(ny-1)*(2*ny-1)/6, & & i=0,nx-1), k=0,nz-1) /), shape(py)) integer, parameter, dimension(nx,ny ) :: pz = & & reshape ((/ (( & & nz*(i+nx*j +1)*(i+nx*j +1+nx*ny*(nz-1)) & & +(nx*ny)**2*nz*(nz-1)*(2*nz-1)/6, & & i=0,nx-1), j=0,ny-1) /), shape(pz)) integer, dimension(nx,ny,nz) :: a integer, dimension( ny,nz) :: ax integer, dimension(nx, nz) :: ay integer, dimension(nx,ny ) :: az logical, dimension(nx,ny,nz) :: m, true integer, dimension(nx,ny) :: b integer, dimension(nx,nx) :: onesx integer, dimension(ny,ny) :: onesy integer, dimension(nz,nz) :: onesz a = p m = reshape((/ ((/ .true., .false. /), i=1,size(m)/2) /), shape(m)) true = reshape((/ (.true., i=1,size(true)) /), shape(true)) onesx = reshape((/ ((1, j=1,i),(0,j=1,nx-i),i=1,size(onesx,2)) /), shape(onesx)) onesy = reshape((/ ((1, j=1,i),(0,j=1,ny-i),i=1,size(onesy,2)) /), shape(onesy)) onesz = reshape((/ ((1, j=1,i),(0,j=1,nz-i),i=1,size(onesz,2)) /), shape(onesz)) ! Correct results in simple cases ax = sum(a,1) if (any(ax /= px)) call abort ay = sum(a,2) if (any(ay /= py)) call abort az = sum(a,3) if (any(az /= pz)) call abort ! Masks work if (any(sum(a,1,.false.) /= 0)) call abort if (any(sum(a,2,.true.) /= py)) call abort if (any(sum(a,3,m) /= merge(pz,0,m(:,:,1)))) call abort if (any(sum(a,2,m) /= merge(sum(a(:, ::2,:),2),& sum(a(:,2::2,:),2),& m(:,1,:)))) call abort ! It works too with array constructors ... if (any(sum( & reshape((/ (i*i,i=1,size(a)) /), shape(a)), & 1, & true) /= ax)) call abort ! ... and with vector subscripts if (any(sum( & a((/ (i,i=1,nx) /), & (/ (i,i=1,ny) /), & (/ (i,i=1,nz) /)), & 1) /= ax)) call abort if (any(sum( & a(sum(onesx(:,:),1), & ! unnecessary { dg-warning "Creating array temporary" } sum(onesy(:,:),1), & ! unnecessary { dg-warning "Creating array temporary" } sum(onesz(:,:),1)), & ! unnecessary { dg-warning "Creating array temporary" } 1) /= ax)) call abort ! Nested sums work if (sum(sum(sum(a,1),1),1) /= sum(a)) call abort if (sum(sum(sum(a,1),2),1) /= sum(a)) call abort if (sum(sum(sum(a,3),1),1) /= sum(a)) call abort if (sum(sum(sum(a,3),2),1) /= sum(a)) call abort if (any(sum(sum(a,1),1) /= sum(sum(a,2),1))) call abort if (any(sum(sum(a,1),2) /= sum(sum(a,3),1))) call abort if (any(sum(sum(a,2),2) /= sum(sum(a,3),2))) call abort ! Temps are unavoidable here (function call's argument or result) ax = sum(neid3(a),1) ! { dg-warning "Creating array temporary" } ! Sums as part of a bigger expr work if (any(1+sum(eid(a),1)+ax+sum( & neid3(a), & ! { dg-warning "Creating array temporary" } 1)+1 /= 3*ax+2)) call abort if (any(1+eid(sum(a,2))+ay+ & neid2( & ! { dg-warning "Creating array temporary" } sum(a,2) & ! { dg-warning "Creating array temporary" } )+1 /= 3*ay+2)) call abort if (any(sum(eid(sum(a,3))+az+2* & neid2(az) & ! { dg-warning "Creating array temporary" } ,1)+1 /= 4*sum(az,1)+1)) call abort if (any(sum(transpose(sum(a,1)),1)+sum(az,1) /= sum(ax,2)+sum(sum(a,3),1))) call abort ! Creates a temp when needed. a(1,:,:) = sum(a,1) ! unnecessary { dg-warning "Creating array temporary" } if (any(a(1,:,:) /= ax)) call abort b = p(:,:,1) call set(b(2:,1), sum(b(:nx-1,:),2)) ! { dg-warning "Creating array temporary" } if (any(b(2:,1) /= ay(1:nx-1,1))) call abort b = p(:,:,1) call set(b(:,1), sum(b,2)) ! unnecessary { dg-warning "Creating array temporary" } if (any(b(:,1) /= ay(:,1))) call abort b = p(:,:,1) call tes(sum(eid(b(:nx-1,:)),2), b(2:,1)) ! { dg-warning "Creating array temporary" } if (any(b(2:,1) /= ay(1:nx-1,1))) call abort b = p(:,:,1) call tes(eid(sum(b,2)), b(:,1)) ! unnecessary { dg-warning "Creating array temporary" } if (any(b(:,1) /= ay(:,1))) call abort contains elemental function eid (x) integer, intent(in) :: x integer :: eid eid = x end function eid function neid2 (x) integer, intent(in) :: x(:,:) integer :: neid2(size(x,1),size(x,2)) neid2 = x end function neid2 function neid3 (x) integer, intent(in) :: x(:,:,:) integer :: neid3(size(x,1),size(x,2),size(x,3)) neid3 = x end function neid3 elemental subroutine set (o, i) integer, intent(in) :: i integer, intent(out) :: o o = i end subroutine set elemental subroutine tes (i, o) integer, intent(in) :: i integer, intent(out) :: o o = i end subroutine tes end ! { dg-final { scan-tree-dump-times "struct array._integer\\(kind=4\\) atmp" 13 "original" } } ! { dg-final { scan-tree-dump-times "struct array\[^\\n\]*atmp" 13 "original" } } ! { dg-final { scan-tree-dump-times "_gfortran_sum_" 0 "original" } } ! { dg-final { cleanup-tree-dump "original" } }