gcc/testsuite/gfortran.dg/zero_sized_1.f90

   1 ! { dg-do run }
   2 ! Transformational functions for zero-sized array and array sections
   3 ! Contributed by Francois-Xavier Coudert  <coudert@clipper.ens.fr>
   4
   5 subroutine test_cshift
   6   real :: tempn(1), tempm(1,2)
   7   real,allocatable :: foo(:),bar(:,:),gee(:,:)
   8   tempn = 2.0
   9   tempm = 1.0
  10   allocate(foo(0),bar(2,0),gee(0,7))
  11   if (any(cshift(foo,dim=1,shift=1)/= 0)) call abort
  12   if (any(cshift(tempn(2:1),dim=1,shift=1)/= 0)) call abort
  13   if (any(cshift(bar,shift=(/1,-1/),dim=1)/= 0)) call abort
  14   if (any(cshift(bar,shift=(/1,-1/),dim=2)/= 0)) call abort
  15   if (any(cshift(gee,shift=(/1,-1/),dim=1)/= 0)) call abort
  16   if (any(cshift(gee,shift=(/1,-1/),dim=2)/= 0)) call abort
  17   if (any(cshift(tempm(5:4,:),shift=(/1,-1/),dim=1)/= 0)) call abort
  18   if (any(cshift(tempm(5:4,:),shift=(/1,-1/),dim=2)/= 0)) call abort
  19   if (any(cshift(tempm(:,5:4),shift=(/1,-1/),dim=1)/= 0)) call abort
  20   if (any(cshift(tempm(:,5:4),shift=(/1,-1/),dim=2)/= 0)) call abort
  21   deallocate(foo,bar,gee)
  22 end
  23
  24 subroutine test_eoshift
  25   real :: tempn(1), tempm(1,2)
  26   real,allocatable :: foo(:),bar(:,:),gee(:,:)
  27   tempn = 2.0
  28   tempm = 1.0
  29   allocate(foo(0),bar(2,0),gee(0,7))
  30   if (any(eoshift(foo,dim=1,shift=1)/= 0)) call abort
  31   if (any(eoshift(tempn(2:1),dim=1,shift=1)/= 0)) call abort
  32   if (any(eoshift(bar,shift=(/1,-1/),dim=1)/= 0)) call abort
  33   if (any(eoshift(bar,shift=(/1,-1/),dim=2)/= 0)) call abort
  34   if (any(eoshift(gee,shift=(/1,-1/),dim=1)/= 0)) call abort
  35   if (any(eoshift(gee,shift=(/1,-1/),dim=2)/= 0)) call abort
  36   if (any(eoshift(tempm(5:4,:),shift=(/1,-1/),dim=1)/= 0)) call abort
  37   if (any(eoshift(tempm(5:4,:),shift=(/1,-1/),dim=2)/= 0)) call abort
  38   if (any(eoshift(tempm(:,5:4),shift=(/1,-1/),dim=1)/= 0)) call abort
  39   if (any(eoshift(tempm(:,5:4),shift=(/1,-1/),dim=2)/= 0)) call abort
  40
  41   if (any(eoshift(foo,dim=1,shift=1,boundary=42.0)/= 0)) call abort
  42   if (any(eoshift(tempn(2:1),dim=1,shift=1,boundary=42.0)/= 0)) call abort
  43   if (any(eoshift(bar,shift=(/1,-1/),dim=1,boundary=42.0)/= 0)) call abort
  44   if (any(eoshift(bar,shift=(/1,-1/),dim=2,boundary=42.0)/= 0)) call abort
  45   if (any(eoshift(gee,shift=(/1,-1/),dim=1,boundary=42.0)/= 0)) call abort
  46   if (any(eoshift(gee,shift=(/1,-1/),dim=2,boundary=42.0)/= 0)) call abort
  47   if (any(eoshift(tempm(5:4,:),shift=(/1,-1/),dim=1,boundary=42.0)/= 0)) call abort
  48   if (any(eoshift(tempm(5:4,:),shift=(/1,-1/),dim=2,boundary=42.0)/= 0)) call abort
  49   if (any(eoshift(tempm(:,5:4),shift=(/1,-1/),dim=1,boundary=42.0)/= 0)) call abort
  50   if (any(eoshift(tempm(:,5:4),shift=(/1,-1/),dim=2,boundary=42.0)/= 0)) call abort
  51
  52   if (any(eoshift(foo,dim=1,shift=1,boundary=(/42.0,-7.0/))/= 0)) call abort
  53   if (any(eoshift(tempn(2:1),dim=1,shift=1,boundary=(/42.0,-7.0/))/= 0)) call abort
  54   if (any(eoshift(bar,shift=(/1,-1/),dim=1,boundary=(/42.0,-7.0/))/= 0)) call abort
  55   if (any(eoshift(bar,shift=(/1,-1/),dim=2,boundary=(/42.0,-7.0/))/= 0)) call abort
  56   if (any(eoshift(gee,shift=(/1,-1/),dim=1,boundary=(/42.0,-7.0/))/= 0)) call abort
  57   if (any(eoshift(gee,shift=(/1,-1/),dim=2,boundary=(/42.0,-7.0/))/= 0)) call abort
  58   if (any(eoshift(tempm(5:4,:),shift=(/1,-1/),dim=1,boundary=(/42.0,-7.0/))/= 0)) call abort
  59   if (any(eoshift(tempm(5:4,:),shift=(/1,-1/),dim=2,boundary=(/42.0,-7.0/))/= 0)) call abort
  60   if (any(eoshift(tempm(:,5:4),shift=(/1,-1/),dim=1,boundary=(/42.0,-7.0/))/= 0)) call abort
  61   if (any(eoshift(tempm(:,5:4),shift=(/1,-1/),dim=2,boundary=(/42.0,-7.0/))/= 0)) call abort
  62   deallocate(foo,bar,gee)
  63 end
  64
  65 subroutine test_transpose
  66   character(len=1) :: tempn(1,2)
  67   character(len=1),allocatable :: foo(:,:), bar(:,:)
  68   integer :: tempm(1,2)
  69   integer,allocatable :: x(:,:), y(:,:)
  70   tempn = 'a'
  71   allocate(foo(3,0),bar(-2:-4,7:9))
  72   tempm = -42
  73   allocate(x(3,0),y(-2:-4,7:9))
  74   if (any(transpose(tempn(-7:-8,:)) /= 'b')) call abort
  75   if (any(transpose(tempn(:,9:8)) /= 'b')) call abort
  76   if (any(transpose(foo) /= 'b')) call abort
  77   if (any(transpose(bar) /= 'b')) call abort
  78   if (any(transpose(tempm(-7:-8,:)) /= 0)) call abort
  79   if (any(transpose(tempm(:,9:8)) /= 0)) call abort
  80   if (any(transpose(x) /= 0)) call abort
  81   if (any(transpose(y) /= 0)) call abort
  82   deallocate(foo,bar,x,y)
  83 end
  84
  85 subroutine test_reshape
  86   character(len=1) :: tempn(1,2)
  87   character(len=1),allocatable :: foo(:,:), bar(:,:)
  88   integer :: tempm(1,2)
  89   integer,allocatable :: x(:,:), y(:,:)
  90   tempn = 'b'
  91   tempm = -42
  92   allocate(foo(3,0),bar(-2:-4,7:9),x(3,0),y(-2:-4,7:9))
  93
  94   if (size(reshape(tempn(-7:-8,:),(/3,3/),pad=(/'a'/))) /= 9 .or. &
  95       any(reshape(tempn(-7:-8,:),(/3,3/),pad=(/'a'/)) /= 'a')) call abort
  96   if (size(reshape(tempn(-7:-8,:),(/3,3,3/),pad=(/'a'/))) /= 27 .or. &
  97       any(reshape(tempn(-7:-8,:),(/3,3,3/),pad=(/'a'/)) /= 'a')) call abort
  98   if (size(reshape(tempn(-7:-8,:),(/3,3,3,3,3,3,3/),pad=(/'a'/))) /= 2187 .or. &
  99       any(reshape(tempn(-7:-8,:),(/3,3,3,3,3,3,3/),pad=(/'a'/)) /= 'a')) call abort
 100   if (size(reshape(foo,(/3,3/),pad=(/'a'/))) /= 9 .or. &
 101       any(reshape(foo,(/3,3/),pad=(/'a'/)) /= 'a')) call abort
 102   if (size(reshape(foo,(/3,3,3/),pad=(/'a'/))) /= 27 .or. &
 103       any(reshape(foo,(/3,3,3/),pad=(/'a'/)) /= 'a')) call abort
 104   if (size(reshape(foo,(/3,3,3,3,3,3,3/),pad=(/'a'/))) /= 2187 .or. &
 105       any(reshape(foo,(/3,3,3,3,3,3,3/),pad=(/'a'/)) /= 'a')) call abort
 106   if (size(reshape(bar,(/3,3/),pad=(/'a'/))) /= 9 .or. &
 107       any(reshape(bar,(/3,3/),pad=(/'a'/)) /= 'a')) call abort
 108   if (size(reshape(bar,(/3,3,3/),pad=(/'a'/))) /= 27 .or. &
 109       any(reshape(bar,(/3,3,3/),pad=(/'a'/)) /= 'a')) call abort
 110   if (size(reshape(bar,(/3,3,3,3,3,3,3/),pad=(/'a'/))) /= 2187 .or. &
 111       any(reshape(bar,(/3,3,3,3,3,3,3/),pad=(/'a'/)) /= 'a')) call abort
 112
 113   if (size(reshape(tempm(-7:-8,:),(/3,3/),pad=(/7/))) /= 9 .or. &
 114       any(reshape(tempm(-7:-8,:),(/3,3/),pad=(/7/)) /= 7)) call abort
 115   if (size(reshape(tempm(-7:-8,:),(/3,3,3/),pad=(/7/))) /= 27 .or. &
 116       any(reshape(tempm(-7:-8,:),(/3,3,3/),pad=(/7/)) /= 7)) call abort
 117   if (size(reshape(tempm(-7:-8,:),(/3,3,3,3,3,3,3/),pad=(/7/))) /= 2187 .or. &
 118       any(reshape(tempm(-7:-8,:),(/3,3,3,3,3,3,3/),pad=(/7/)) /= 7)) call abort
 119   if (size(reshape(x,(/3,3/),pad=(/7/))) /= 9 .or. &
 120       any(reshape(x,(/3,3/),pad=(/7/)) /= 7)) call abort
 121   if (size(reshape(x,(/3,3,3/),pad=(/7/))) /= 27 .or. &
 122       any(reshape(x,(/3,3,3/),pad=(/7/)) /= 7)) call abort
 123   if (size(reshape(x,(/3,3,3,3,3,3,3/),pad=(/7/))) /= 2187 .or. &
 124       any(reshape(x,(/3,3,3,3,3,3,3/),pad=(/7/)) /= 7)) call abort
 125   if (size(reshape(y,(/3,3/),pad=(/7/))) /= 9 .or. &
 126       any(reshape(y,(/3,3/),pad=(/7/)) /= 7)) call abort
 127   if (size(reshape(y,(/3,3,3/),pad=(/7/))) /= 27 .or. &
 128       any(reshape(y,(/3,3,3/),pad=(/7/)) /= 7)) call abort
 129   if (size(reshape(y,(/3,3,3,3,3,3,3/),pad=(/7/))) /= 2187 .or. &
 130       any(reshape(y,(/3,3,3,3,3,3,3/),pad=(/7/)) /= 7)) call abort
 131
 132   deallocate(foo,bar,x,y)
 133 end
 134
 135 subroutine test_pack
 136   integer :: tempn(1,5)
 137   integer,allocatable :: foo(:,:)
 138   tempn = 2
 139   allocate(foo(0,1:7))
 140   if (size(pack(foo,foo/=0)) /= 0 .or. any(pack(foo,foo/=0) /= -42)) call abort
 141   if (size(pack(foo,foo/=0,(/1,3,4,5,1,0,7,9/))) /= 8 .or. &
 142       sum(pack(foo,foo/=0,(/1,3,4,5,1,0,7,9/))) /= 30) call abort
 143   if (size(pack(tempn(:,-4:-5),tempn(:,-4:-5)/=0)) /= 0 .or. &
 144       any(pack(tempn(:,-4:-5),tempn(:,-4:-5)/=0) /= -42)) call abort
 145   if (size(pack(tempn(:,-4:-5),tempn(:,-4:-5)/=0,(/1,3,4,5,1,0,7,9/))) /= 8 .or. &
 146       sum(pack(tempn(:,-4:-5),tempn(:,-4:-5)/=0,(/1,3,4,5,1,0,7,9/))) /= 30) &
 147     call abort
 148   if (size(pack(foo,.true.)) /= 0 .or. any(pack(foo,.true.) /= -42)) &
 149     call abort
 150   if (size(pack(foo,.true.,(/1,3,4,5,1,0,7,9/))) /= 8 .or. &
 151       sum(pack(foo,.true.,(/1,3,4,5,1,0,7,9/))) /= 30) call abort
 152   if (size(pack(tempn(:,-4:-5),.true.)) /= 0 .or. &
 153       any(pack(foo,.true.) /= -42)) call abort
 154   if (size(pack(tempn(:,-4:-5),.true.,(/1,3,4,5,1,0,7,9/))) /= 8 .or. &
 155       sum(pack(tempn(:,-4:-5),.true.,(/1,3,4,5,1,0,7,9/))) /= 30) call abort
 156   deallocate(foo)
 157 end
 158
 159 subroutine test_unpack
 160   integer :: tempn(1,5), tempv(5)
 161   integer,allocatable :: foo(:,:), bar(:)
 162   tempn = 2
 163   tempv = 5
 164   allocate(foo(0,1:7),bar(0:-1))
 165   if (any(unpack(tempv,tempv/=0,tempv) /= 5) .or. &
 166       size(unpack(tempv,tempv/=0,tempv)) /= 5) call abort
 167   if (any(unpack(tempv(1:0),tempv/=0,tempv) /= 5) .or. &
 168       size(unpack(tempv(1:0),tempv/=0,tempv)) /= 5) call abort
 169   if (any(unpack(tempv,tempv(1:0)/=0,tempv) /= -47)) call abort
 170   if (any(unpack(tempv(5:4),tempv(1:0)/=0,tempv) /= -47)) call abort
 171   if (any(unpack(bar,foo==foo,foo) /= -47)) call abort
 172   deallocate(foo,bar)
 173 end
 174
 175 subroutine test_spread
 176   real :: tempn(1)
 177   real,allocatable :: foo(:)
 178   tempn = 2.0
 179   allocate(foo(0))
 180   if (any(spread(1,dim=1,ncopies=0) /= -17.0) .or. &
 181       size(spread(1,dim=1,ncopies=0)) /= 0) call abort
 182   if (any(spread(foo,dim=1,ncopies=1) /= -17.0) .or. &
 183       size(spread(foo,dim=1,ncopies=1)) /= 0) call abort
 184   if (any(spread(tempn(2:1),dim=1,ncopies=1) /= -17.0) .or. &
 185       size(spread(tempn(2:1),dim=1,ncopies=1)) /= 0) call abort
 186   deallocate(foo)
 187 end
 188
 189 program test
 190   call test_cshift
 191   call test_eoshift
 192   call test_transpose
 193   call test_unpack
 194   call test_spread
 195   call test_pack
 196 !  call test_reshape
 197 end