gcc/testsuite/gfortran.dg/maxloc_4.f90

   1 ! { dg-do  run }
   2 ! Check that simplification of maxloc works
   3 program main
   4   implicit none
   5   integer :: d
   6   real, dimension(2), parameter :: a = [1.0, 0.0]
   7   character(len=3), dimension(3), parameter :: c = [ "fgh", "asd", "jkl" ]
   8   integer, parameter :: b = maxloc(a,dim=1)
   9   integer, parameter :: b2 = maxloc(a,dim=1,mask=[.false.,.false.])
  10   integer, parameter :: b3 = maxloc(c,dim=1)
  11   integer, parameter :: b4 = maxloc(c,dim=1,mask=[c<"iii"])
  12   integer, parameter,dimension(2,2) :: i1 = reshape([4,5,3,2],shape(i1))
  13   integer, parameter, dimension(2) :: b5 = maxloc(i1)
  14   integer, parameter, dimension(2) :: b6 = maxloc(i1,mask=i1>7)
  15   integer, parameter, dimension(2) :: b7 = maxloc(i1, mask=i1<5)
  16   integer, parameter, dimension(2) :: b8 = maxloc(i1, mask=.true.)
  17   integer, parameter, dimension(2) :: b9 = maxloc(i1, mask=.false.)
  18   integer, parameter, dimension(2,3) :: i2 = &
  19        reshape([2, -1, -3, 4, -5, 6], shape(i2))
  20   integer, parameter, dimension(3) :: b10 = maxloc(i2, dim=1)
  21   integer, parameter, dimension(2) :: b11 = maxloc(i2, dim=2)
  22   integer, parameter, dimension(3) :: b12 = maxloc(i2,dim=1,mask=i2<0)
  23   integer, parameter, dimension(2) :: b13 = maxloc(i2,dim=2, mask=i2<-10)
  24   if (b /= 1) call abort
  25   if (b2 /= 0) call abort
  26   if (b3 /= 3) call abort
  27   if (b4 /= 1) call abort
  28   if (any(b5 /= [2,1])) call abort
  29   if (any(b6 /= [0, 0])) call abort
  30   if (any(b7 /= [1,1])) call abort
  31   if (any(b8 /= b5)) call abort
  32   if (any(b9 /= [0, 0])) call abort
  33   d = 1
  34   if (any(b10 /= maxloc(i2,dim=d))) call abort
  35   d = 2
  36   if (any(b11 /= maxloc(i2,dim=2))) call abort
  37   d = 1
  38   if (any(b12 /= maxloc(i2, dim=d,mask=i2<0))) call abort
  39   if (any(b13 /= 0)) call abort
  40 end program main