gcc/testsuite/gfortran.dg/minval_char_4.f90

   1 ! { dg-do run }
   2 program main
   3   implicit none
   4   integer, parameter :: n=5
   5   character(len=6,kind=4), dimension(n,n) :: a
   6   integer, dimension(n,n) :: v
   7   character(len=6,kind=4), dimension(n) :: r1, r2
   8   character(len=6,kind=4), dimension(:,:), allocatable :: a_alloc
   9   integer, dimension(:,:), allocatable :: v_alloc
  10   character(len=6,kind=4):: all_full
  11   integer :: i
  12   character(len=6,kind=4),dimension(1) :: ret
  13   logical, dimension(n,n) :: mask
  14   logical :: smask
  15   integer(kind=4), dimension(6) :: kmin
  16
  17   kmin = -1
  18   all_full = transfer(kmin,all_full)
  19   v = reshape([(i*i+200-17*i,i=1,n*n)],shape(v))
  20   write (unit=a,fmt='(I6.6)') (i*i+200-17*i,i=1,n*n)
  21
  22   r1 =  minval(a,dim=1)
  23   write (unit=r2,fmt='(I6.6)') minval(v,dim=1)
  24   if (any (r1 /= r2)) STOP 1
  25   r1 = 4_'x'
  26   write (unit=r1,fmt='(I6.6)') minval(v,dim=1)
  27   if (any (r1 /= r2)) STOP 2
  28
  29   r1 = 4_'y'
  30   r1 =  minval(a,dim=2)
  31   write (unit=r2,fmt='(I6.6)') minval(v,dim=2)
  32   if (any (r1 /= r2)) STOP 3
  33   r1 = 4_'z'
  34   write (unit=r1,fmt='(I6.6)') minval(v,dim=2)
  35   if (any (r1 /= r2)) STOP 4
  36
  37   allocate (a_alloc(0,1), v_alloc(0,1))
  38   ret = 4_'what'
  39   ret = minval(a_alloc,dim=1)
  40   if (ret(1) /= all_full) STOP 5
  41
  42   r1 = 4_'qq'
  43   r1 = minval(a, dim=1, mask=a>4_"000200");
  44   if (any(r1 /= all_full .neqv. minval(v,dim=1, mask=v>200) < 1000)) STOP 6
  45   if (any(minval(a, dim=1, mask=a>4_"000200") /= all_full .neqv. minval(v,dim=1, mask=v>200) < 1000)) STOP 7
  46
  47   r1 = 4_'rr'
  48   r1 = minval(a, dim=2, mask=a>4_"000200");
  49   if (any(r1 /= all_full .neqv. minval(v,dim=2, mask=v>200) < 1000)) STOP 8
  50   if (any(minval(a, dim=2, mask=a>4_"000200") /= all_full .neqv. minval(v,dim=2, mask=v>200) < 1000)) STOP 9
  51
  52   mask = .true.
  53   forall (i=1:n)
  54      mask(i,i) = .false.
  55   end forall
  56
  57   r1 = 4_'aa'
  58   r1 = minval(a, dim=1, mask=mask)
  59   write(unit=r2,fmt='(I6.6)') minval(v,dim=1, mask=mask)
  60   if (any(r1 /= r2)) STOP 10
  61
  62   r1 = 4_'xyz'
  63   smask = .true.
  64   r1 = minval(a, dim=1, mask=smask)
  65   write (unit=r2,fmt='(I6.6)') minval(v,dim=1)
  66   if (any (r1 /= r2)) STOP 11
  67
  68   smask = .false.
  69   r1 = 4_'foobar'
  70   r1 = minval(a, dim=1, mask=smask)
  71   if (any(r1 /= all_full)) STOP 12
  72 end program main