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