gcc/testsuite/gfortran.dg/reduction.f90

   1 ! { dg-do run }
   2 ! PR 16946
   3 ! Not all allowed combinations of arguments for MAXVAL, MINVAL,
   4 ! PRODUCT and SUM were supported.
   5 program reduction_mask
   6   implicit none
   7   logical :: equal(3)
   8
   9   integer, parameter :: res(4*9) = (/ 3, 3, 3, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, &
  10        1, 1, 1, 1, 1, 6, 6, 6, 2, 2, 2, 2, 2, 2, 6, 6, 6, 3, 3, 3, 3, 3, 3 /)
  11   integer :: val(4*9)
  12   complex :: cval(2*9), cin(3)
  13
  14   equal = (/ .true., .true., .false. /)
  15
  16   ! use all combinations of the dim and mask arguments for the
  17   ! reduction intrinsics
  18   val( 1) = maxval((/ 1, 2, 3 /))
  19   val( 2) = maxval((/ 1, 2, 3 /), 1)
  20   val( 3) = maxval((/ 1, 2, 3 /), dim=1)
  21   val( 4) = maxval((/ 1, 2, 3 /), equal)
  22   val( 5) = maxval((/ 1, 2, 3 /), mask=equal)
  23   val( 6) = maxval((/ 1, 2, 3 /), 1, equal)
  24   val( 7) = maxval((/ 1, 2, 3 /), 1, mask=equal)
  25   val( 8) = maxval((/ 1, 2, 3 /), dim=1, mask=equal)
  26   val( 9) = maxval((/ 1, 2, 3 /), mask=equal, dim=1)
  27
  28   val(10) = minval((/ 1, 2, 3 /))
  29   val(11) = minval((/ 1, 2, 3 /), 1)
  30   val(12) = minval((/ 1, 2, 3 /), dim=1)
  31   val(13) = minval((/ 1, 2, 3 /), equal)
  32   val(14) = minval((/ 1, 2, 3 /), mask=equal)
  33   val(15) = minval((/ 1, 2, 3 /), 1, equal)
  34   val(16) = minval((/ 1, 2, 3 /), 1, mask=equal)
  35   val(17) = minval((/ 1, 2, 3 /), dim=1, mask=equal)
  36   val(18) = minval((/ 1, 2, 3 /), mask=equal, dim=1)
  37
  38   val(19) = product((/ 1, 2, 3 /))
  39   val(20) = product((/ 1, 2, 3 /), 1)
  40   val(21) = product((/ 1, 2, 3 /), dim=1)
  41   val(22) = product((/ 1, 2, 3 /), equal)
  42   val(23) = product((/ 1, 2, 3 /), mask=equal)
  43   val(24) = product((/ 1, 2, 3 /), 1, equal)
  44   val(25) = product((/ 1, 2, 3 /), 1, mask=equal)
  45   val(26) = product((/ 1, 2, 3 /), dim=1, mask=equal)
  46   val(27) = product((/ 1, 2, 3 /), mask=equal, dim=1)
  47
  48   val(28) = sum((/ 1, 2, 3 /))
  49   val(29) = sum((/ 1, 2, 3 /), 1)
  50   val(30) = sum((/ 1, 2, 3 /), dim=1)
  51   val(31) = sum((/ 1, 2, 3 /), equal)
  52   val(32) = sum((/ 1, 2, 3 /), mask=equal)
  53   val(33) = sum((/ 1, 2, 3 /), 1, equal)
  54   val(34) = sum((/ 1, 2, 3 /), 1, mask=equal)
  55   val(35) = sum((/ 1, 2, 3 /), dim=1, mask=equal)
  56   val(36) = sum((/ 1, 2, 3 /), mask=equal, dim=1)
  57
  58   if (any (val /= res)) call abort
  59
  60   ! Tests for complex arguments. These were broken by the original fix.
  61
  62   cin = cmplx((/1,2,3/))
  63
  64   cval(1) = product(cin)
  65   cval(2) = product(cin, 1)
  66   cval(3) = product(cin, dim=1)
  67   cval(4) = product(cin, equal)
  68   cval(5) = product(cin, mask=equal)
  69   cval(6) = product(cin, 1, equal)
  70   cval(7) = product(cin, 1, mask=equal)
  71   cval(8) = product(cin, dim=1, mask=equal)
  72   cval(9) = product(cin, mask=equal, dim=1)
  73
  74   cval(10) = sum(cin)
  75   cval(11) = sum(cin, 1)
  76   cval(12) = sum(cin, dim=1)
  77   cval(13) = sum(cin, equal)
  78   cval(14) = sum(cin, mask=equal)
  79   cval(15) = sum(cin, 1, equal)
  80   cval(16) = sum(cin, 1, mask=equal)
  81   cval(17) = sum(cin, dim=1, mask=equal)
  82   cval(18) = sum(cin, mask=equal, dim=1)
  83
  84   if (any (cval /= cmplx(res(19:36)))) call abort
  85 end program reduction_mask