gcc/testsuite/gfortran.dg/inline_sum_1.f90

   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
 154 contains
 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
 190 end
 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" } }