gcc/testsuite/gfortran.dg/minmaxloc_1.f90

   1 ! { dg-do run }
   2 ! Check max/minloc.
   3 ! PR fortran/31726
   4 !
   5 program test
   6   implicit none
   7   integer :: i(1), j(-1:1), res(1)
   8   logical, volatile :: m(3), m2(3)
   9   m = (/ .false., .false., .false. /)
  10   m2 = (/ .false., .true., .false. /)
  11   call check(1, 0, MAXLOC((/ 42, 23, 11 /), DIM=1, MASK=.FALSE.))
  12   call check(2, 0, MAXLOC((/ 42, 23, 11 /), DIM=1, MASK=m))
  13   call check(3, 2, MAXLOC((/ 42, 23, 11 /), DIM=1, MASK=m2))
  14   call check(4, 0, MAXLOC(i(1:0), DIM=1, MASK=.TRUE.))
  15   call check(5, 0, MAXLOC(i(1:0), DIM=1, MASK=.FALSE.))
  16   call check(6, 0, MAXLOC(i(1:0), DIM=1, MASK=m(1:0)))
  17   call check(7, 0, MAXLOC(i(1:0), DIM=1))
  18   call check(8, 0, MINLOC((/ 42, 23, 11 /), DIM=1, MASK=.FALSE.))
  19   call check(9, 0, MINLOC((/ 42, 23, 11 /), DIM=1, MASK=m))
  20   call check(10, 0, MINLOC(i(1:0), DIM=1, MASK=.FALSE.))
  21   call check(11,0, MINLOC(i(1:0), DIM=1, MASK=m(1:0)))
  22   call check(12,0, MINLOC(i(1:0), DIM=1, MASK=.TRUE.))
  23   call check(13,0, MINLOC(i(1:0), DIM=1))
  24
  25   j = (/ 1, 2, 1 /); call check(14, 2, MAXLOC(j, DIM=1))
  26   j = (/ 1, 2, 3 /); call check(15, 3, MAXLOC(j, DIM=1))
  27   j = (/ 3, 2, 1 /); call check(16, 1, MAXLOC(j, DIM=1))
  28   j = (/ 1, 2, 1 /); call check(17, 1, MINLOC(j, DIM=1))
  29   j = (/ 1, 2, 3 /); call check(18, 1, MINLOC(j, DIM=1))
  30   j = (/ 3, 2, 1 /); call check(19, 3, MINLOC(j, DIM=1))
  31
  32   j = (/ 1, 2, 1 /); call check(20, 2, MAXLOC(j, DIM=1,mask=.true.))
  33   j = (/ 1, 2, 3 /); call check(21, 3, MAXLOC(j, DIM=1,mask=.true.))
  34   j = (/ 3, 2, 1 /); call check(22, 1, MAXLOC(j, DIM=1,mask=.true.))
  35   j = (/ 1, 2, 1 /); call check(23, 1, MINLOC(j, DIM=1,mask=.true.))
  36   j = (/ 1, 2, 3 /); call check(24, 1, MINLOC(j, DIM=1,mask=.true.))
  37   j = (/ 3, 2, 1 /); call check(25, 3, MINLOC(j, DIM=1,mask=.true.))
  38
  39   j = (/ 1, 2, 1 /); call check(26, 0, MAXLOC(j, DIM=1,mask=.false.))
  40   j = (/ 1, 2, 3 /); call check(27, 0, MAXLOC(j, DIM=1,mask=.false.))
  41   j = (/ 3, 2, 1 /); call check(28, 0, MAXLOC(j, DIM=1,mask=.false.))
  42   j = (/ 1, 2, 1 /); call check(29, 0, MINLOC(j, DIM=1,mask=.false.))
  43   j = (/ 1, 2, 3 /); call check(30, 0, MINLOC(j, DIM=1,mask=.false.))
  44   j = (/ 3, 2, 1 /); call check(31, 0, MINLOC(j, DIM=1,mask=.false.))
  45
  46   j = (/ 1, 2, 1 /); call check(32, 0, MAXLOC(j, DIM=1,mask=m))
  47   j = (/ 1, 2, 3 /); call check(33, 0, MAXLOC(j, DIM=1,mask=m))
  48   j = (/ 3, 2, 1 /); call check(34, 0, MAXLOC(j, DIM=1,mask=m))
  49   j = (/ 1, 2, 1 /); call check(35, 0, MINLOC(j, DIM=1,mask=m))
  50   j = (/ 1, 2, 3 /); call check(36, 0, MINLOC(j, DIM=1,mask=m))
  51   j = (/ 3, 2, 1 /); call check(37, 0, MINLOC(j, DIM=1,mask=m))
  52
  53   j = (/ 1, 2, 1 /); call check(38, 2, MAXLOC(j, DIM=1,mask=m2))
  54   j = (/ 1, 2, 3 /); call check(39, 2, MAXLOC(j, DIM=1,mask=m2))
  55   j = (/ 3, 2, 1 /); call check(40, 2, MAXLOC(j, DIM=1,mask=m2))
  56   j = (/ 1, 2, 1 /); call check(41, 2, MINLOC(j, DIM=1,mask=m2))
  57   j = (/ 1, 2, 3 /); call check(42, 2, MINLOC(j, DIM=1,mask=m2))
  58   j = (/ 3, 2, 1 /); call check(43, 2, MINLOC(j, DIM=1,mask=m2))
  59
  60 ! Check the library minloc and maxloc
  61   res = MAXLOC((/ 42, 23, 11 /), MASK=.FALSE.); call check(44, 0,  res(1))
  62   res = MAXLOC((/ 42, 23, 11 /), MASK=m); call check(45, 0,  res(1))
  63   res = MAXLOC((/ 42, 23, 11 /), MASK=m2); call check(46, 2,  res(1))
  64   res = MAXLOC(i(1:0), MASK=.TRUE.); call check(47, 0,  res(1))
  65   res = MAXLOC(i(1:0), MASK=.FALSE.); call check(48, 0,  res(1))
  66   res = MAXLOC(i(1:0), MASK=m(1:0)); call check(49, 0,  res(1))
  67   res = MAXLOC(i(1:0)); call check(50, 0,  res(1))
  68   res = MINLOC((/ 42, 23, 11 /), MASK=.FALSE.); call check(51, 0, res(1))
  69   res = MINLOC((/ 42, 23, 11 /), MASK=m); call check(52, 0, res(1))
  70   res = MINLOC(i(1:0), MASK=.FALSE.); call check(53, 0, res(1))
  71   res = MINLOC(i(1:0), MASK=m(1:0)); call check(54,0, res(1))
  72   res = MINLOC(i(1:0), MASK=.TRUE.); call check(55,0, res(1))
  73   res = MINLOC(i(1:0)); call check(56,0, res(1))
  74
  75   j = (/ 1, 2, 1 /); res = MAXLOC(j); call check(57, 2,  res(1))
  76   j = (/ 1, 2, 3 /); res = MAXLOC(j); call check(58, 3,  res(1))
  77   j = (/ 3, 2, 1 /); res = MAXLOC(j); call check(59, 1,  res(1))
  78   j = (/ 1, 2, 1 /); res = MINLOC(j); call check(60, 1, res(1))
  79   j = (/ 1, 2, 3 /); res = MINLOC(j); call check(61, 1, res(1))
  80   j = (/ 3, 2, 1 /); res = MINLOC(j); call check(62, 3, res(1))
  81
  82   j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=.true.); call check(63, 2,  res(1))
  83   j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=.true.); call check(65, 3,  res(1))
  84   j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=.true.); call check(66, 1,  res(1))
  85   j = (/ 1, 2, 1 /); res = MINLOC(j,mask=.true.); call check(67, 1, res(1))
  86   j = (/ 1, 2, 3 /); res = MINLOC(j,mask=.true.); call check(68, 1, res(1))
  87   j = (/ 3, 2, 1 /); res = MINLOC(j,mask=.true.); call check(69, 3, res(1))
  88
  89   j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=.false.); call check(70, 0,  res(1))
  90   j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=.false.); call check(71, 0,  res(1))
  91   j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=.false.); call check(72, 0,  res(1))
  92   j = (/ 1, 2, 1 /); res = MINLOC(j,mask=.false.); call check(73, 0, res(1))
  93   j = (/ 1, 2, 3 /); res = MINLOC(j,mask=.false.); call check(74, 0, res(1))
  94   j = (/ 3, 2, 1 /); res = MINLOC(j,mask=.false.); call check(75, 0, res(1))
  95
  96   j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=m); call check(76, 0,  res(1))
  97   j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=m); call check(77, 0,  res(1))
  98   j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=m); call check(78, 0,  res(1))
  99   j = (/ 1, 2, 1 /); res = MINLOC(j,mask=m); call check(79, 0, res(1))
 100   j = (/ 1, 2, 3 /); res = MINLOC(j,mask=m); call check(80, 0, res(1))
 101   j = (/ 3, 2, 1 /); res = MINLOC(j,mask=m);call check(81, 0, res(1))
 102
 103   j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=m2); call check(82, 2,  res(1))
 104   j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=m2); call check(83, 2,  res(1))
 105   j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=m2); call check(84, 2,  res(1))
 106   j = (/ 1, 2, 1 /); res = MINLOC(j,mask=m2); call check(85, 2, res(1))
 107   j = (/ 1, 2, 3 /); res = MINLOC(j,mask=m2); call check(86, 2, res(1))
 108   j = (/ 3, 2, 1 /); res = MINLOC(j,mask=m2); call check(87, 2, res(1))
 109
 110 contains
 111 subroutine check(n, i,j)
 112   integer, value, intent(in) :: i,j,n
 113   if(i /= j) then
 114      call abort()
 115 !    print *, 'ERROR: Test',n,' expected ',i,' received ', j
 116   end if
 117 end subroutine check
 118 end program