gcc/testsuite/gfortran.dg/minloc_string_1.f90

   1 ! { dg-do run }
   2 ! Test minloc for strings for different code paths
   3
   4 program main
   5   implicit none
   6   integer, parameter :: n=4
   7   character(len=4), dimension(n,n) :: c
   8   integer, dimension(n,n) :: a
   9   integer, dimension(2) :: res1, res2
  10   real, dimension(n,n) :: r
  11   logical, dimension(n,n) :: amask
  12   logical(kind=8) :: smask
  13   integer :: i,j
  14   integer, dimension(n) :: q1, q2
  15   character(len=4,kind=4), dimension(n,n) :: c4
  16   character(len=4), dimension(n*n) :: e
  17   integer, dimension(n*n) :: f
  18   logical, dimension(n*n) :: cmask
  19
  20   call random_number (r)
  21   a = int(r*100)
  22   do j=1,n
  23      do i=1,n
  24         write (unit=c(i,j),fmt='(I4.4)') a(i,j)
  25         write (unit=c4(i,j),fmt='(I4.4)') a(i,j)
  26      end do
  27   end do
  28   res1 = minloc(c)
  29   res2 = minloc(a)
  30
  31   if (any(res1 /= res2)) call abort
  32   res1 = minloc(c4)
  33   if (any(res1 /= res2)) call abort
  34
  35   amask = a < 50
  36   res1 = minloc(c,mask=amask)
  37   res2 = minloc(a,mask=amask)
  38
  39  if (any(res1 /= res2)) call abort
  40
  41  amask = .false.
  42  res1 = minloc(c,mask=amask)
  43  if (any(res1 /= 0)) call abort
  44
  45  amask(2,3) = .true.
  46  res1 = minloc(c,mask=amask)
  47  if (any(res1 /= [2,3])) call abort
  48
  49  res1 = minloc(c,mask=.false.)
  50  if (any(res1 /= 0)) call abort
  51
  52  res2 = minloc(a)
  53  res1 = minloc(c,mask=.true.)
  54  if (any(res1 /= res2)) call abort
  55
  56  q1 = minloc(c, dim=1)
  57  q2 = minloc(a, dim=1)
  58  if (any(q1 /= q2)) call abort
  59
  60  q1 = minloc(c, dim=2)
  61  q2 = minloc(a, dim=2)
  62  if (any(q1 /= q2)) call abort
  63
  64  q1 = minloc(c, dim=1, mask=amask)
  65  q2 = minloc(a, dim=1, mask=amask)
  66  if (any(q1 /= q2)) call abort
  67
  68  q1 = minloc(c, dim=2, mask=amask)
  69  q2 = minloc(a, dim=2, mask=amask)
  70  if (any(q1 /= q2)) call abort
  71
  72   amask = a < 50
  73
  74  q1 = minloc(c, dim=1, mask=amask)
  75  q2 = minloc(a, dim=1, mask=amask)
  76  if (any(q1 /= q2)) call abort
  77
  78  q1 = minloc(c, dim=2, mask=amask)
  79  q2 = minloc(a, dim=2, mask=amask)
  80  if (any(q1 /= q2)) call abort
  81
  82  e = reshape(c, shape(e))
  83  f = reshape(a, shape(f))
  84  if (minloc(e,dim=1) /= minloc(f,dim=1)) call abort
  85
  86  cmask = .false.
  87  if (minloc(e,dim=1,mask=cmask) /= 0) call abort
  88
  89  cmask = f > 50
  90  if ( minloc(e, dim=1, mask=cmask) /= minloc (f, dim=1, mask=cmask)) call abort
  91 end program main