gcc/testsuite/gfortran.dg/minlocval_4.f90

   1 ! { dg-do run }
   2 ! { dg-add-options ieee }
   3 ! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
   4   real :: a(3,3), b(3), nan, minf, pinf, h
   5   logical :: l, l2
   6   logical :: l3(3,3), l4(3,3), l5(3,3)
   7
   8   nan = 0.0
   9   minf = 0.0
  10   pinf = 0.0
  11   nan = 0.0/nan
  12   minf = -1.0/minf
  13   pinf = 1.0/pinf
  14   h = huge(h)
  15   l = .false.
  16   l2 = .true.
  17   l3 = .false.
  18   l4 = .true.
  19   l5 = .true.
  20   l5(1,1) = .false.
  21   l5(1,2) = .false.
  22   l5(2,3) = .false.
  23   a = reshape ((/ nan, nan, nan, pinf, pinf, pinf, pinf, minf, pinf /), (/ 3, 3 /))
  24   if (minval (a).ne.minf) call abort
  25   if (any (minloc (a).ne.(/ 2, 3 /))) call abort
  26   b = minval (a, dim = 1)
  27   if (.not.isnan(b(1))) call abort
  28   b(1) = 0.0
  29   if (any (b.ne.(/ 0.0, pinf, minf /))) call abort
  30   if (any (minloc (a, dim = 1).ne.(/ 1, 1, 2 /))) call abort
  31   b = minval (a, dim = 2)
  32   if (any (b.ne.(/ pinf, minf, pinf /))) call abort
  33   if (any (minloc (a, dim = 2).ne.(/ 2, 3, 2 /))) call abort
  34   if (minval (a, mask = l).ne.h) call abort
  35   if (any (minloc (a, mask = l).ne.(/ 0, 0 /))) call abort
  36   b = minval (a, dim = 1, mask = l)
  37   if (any (b.ne.(/ h, h, h /))) call abort
  38   if (any (minloc (a, dim = 1, mask = l).ne.(/ 0, 0, 0 /))) call abort
  39   b = minval (a, dim = 2, mask = l)
  40   if (any (b.ne.(/ h, h, h /))) call abort
  41   if (any (minloc (a, dim = 2, mask = l).ne.(/ 0, 0, 0 /))) call abort
  42   if (minval (a, mask = l3).ne.h) call abort
  43   if (any (minloc (a, mask = l3).ne.(/ 0, 0 /))) call abort
  44   b = minval (a, dim = 1, mask = l3)
  45   if (any (b.ne.(/ h, h, h /))) call abort
  46   if (any (minloc (a, dim = 1, mask = l3).ne.(/ 0, 0, 0 /))) call abort
  47   b = minval (a, dim = 2, mask = l3)
  48   if (any (b.ne.(/ h, h, h /))) call abort
  49   if (any (minloc (a, dim = 2, mask = l3).ne.(/ 0, 0, 0 /))) call abort
  50   if (minval (a, mask = l2).ne.minf) call abort
  51   if (minval (a, mask = l4).ne.minf) call abort
  52   if (any (minloc (a, mask = l2).ne.(/ 2, 3 /))) call abort
  53   if (any (minloc (a, mask = l4).ne.(/ 2, 3 /))) call abort
  54   b = minval (a, dim = 1, mask = l2)
  55   if (.not.isnan(b(1))) call abort
  56   b(1) = 0.0
  57   if (any (b.ne.(/ 0.0, pinf, minf /))) call abort
  58   if (any (minloc (a, dim = 1, mask = l2).ne.(/ 1, 1, 2 /))) call abort
  59   b = minval (a, dim = 2, mask = l2)
  60   if (any (b.ne.(/ pinf, minf, pinf /))) call abort
  61   if (any (minloc (a, dim = 2, mask = l2).ne.(/ 2, 3, 2 /))) call abort
  62   b = minval (a, dim = 1, mask = l4)
  63   if (.not.isnan(b(1))) call abort
  64   b(1) = 0.0
  65   if (any (b.ne.(/ 0.0, pinf, minf /))) call abort
  66   if (any (minloc (a, dim = 1, mask = l2).ne.(/ 1, 1, 2 /))) call abort
  67   b = minval (a, dim = 2, mask = l4)
  68   if (any (b.ne.(/ pinf, minf, pinf /))) call abort
  69   if (any (minloc (a, dim = 2, mask = l2).ne.(/ 2, 3, 2 /))) call abort
  70   if (minval (a, mask = l5).ne.pinf) call abort
  71   if (any (minloc (a, mask = l5).ne.(/ 2, 2 /))) call abort
  72   b = minval (a, dim = 1, mask = l5)
  73   if (.not.isnan(b(1))) call abort
  74   b(1) = 0.0
  75   if (any (b.ne.(/ 0.0, pinf, pinf /))) call abort
  76   if (any (minloc (a, dim = 1, mask = l5).ne.(/ 2, 2, 1 /))) call abort
  77   b = minval (a, dim = 2, mask = l5)
  78   if (any (b.ne.(/ pinf, pinf, pinf /))) call abort
  79   if (any (minloc (a, dim = 2, mask = l5).ne.(/ 3, 2, 2 /))) call abort
  80   a = nan
  81   if (.not.isnan(minval (a))) call abort
  82   if (minval (a, mask = l).ne.h) call abort
  83   if (.not.isnan(minval (a, mask = l2))) call abort
  84   if (minval (a, mask = l3).ne.h) call abort
  85   if (.not.isnan(minval (a, mask = l4))) call abort
  86   if (.not.isnan(minval (a, mask = l5))) call abort
  87   if (any (minloc (a).ne.(/ 1, 1 /))) call abort
  88   if (any (minloc (a, mask = l).ne.(/ 0, 0 /))) call abort
  89   if (any (minloc (a, mask = l2).ne.(/ 1, 1 /))) call abort
  90   if (any (minloc (a, mask = l3).ne.(/ 0, 0 /))) call abort
  91   if (any (minloc (a, mask = l4).ne.(/ 1, 1 /))) call abort
  92   if (any (minloc (a, mask = l5).ne.(/ 2, 1 /))) call abort
  93   a = pinf
  94   if (minval (a).ne.pinf) call abort
  95   if (minval (a, mask = l).ne.h) call abort
  96   if (minval (a, mask = l2).ne.pinf) call abort
  97   if (minval (a, mask = l3).ne.h) call abort
  98   if (minval (a, mask = l4).ne.pinf) call abort
  99   if (minval (a, mask = l5).ne.pinf) call abort
 100   if (any (minloc (a).ne.(/ 1, 1 /))) call abort
 101   if (any (minloc (a, mask = l).ne.(/ 0, 0 /))) call abort
 102   if (any (minloc (a, mask = l2).ne.(/ 1, 1 /))) call abort
 103   if (any (minloc (a, mask = l3).ne.(/ 0, 0 /))) call abort
 104   if (any (minloc (a, mask = l4).ne.(/ 1, 1 /))) call abort
 105   if (any (minloc (a, mask = l5).ne.(/ 2, 1 /))) call abort
 106   a = nan
 107   a(1,3) = pinf
 108   if (minval (a).ne.pinf) call abort
 109   if (minval (a, mask = l).ne.h) call abort
 110   if (minval (a, mask = l2).ne.pinf) call abort
 111   if (minval (a, mask = l3).ne.h) call abort
 112   if (minval (a, mask = l4).ne.pinf) call abort
 113   if (minval (a, mask = l5).ne.pinf) call abort
 114   if (any (minloc (a).ne.(/ 1, 3 /))) call abort
 115   if (any (minloc (a, mask = l).ne.(/ 0, 0 /))) call abort
 116   if (any (minloc (a, mask = l2).ne.(/ 1, 3 /))) call abort
 117   if (any (minloc (a, mask = l3).ne.(/ 0, 0 /))) call abort
 118   if (any (minloc (a, mask = l4).ne.(/ 1, 3 /))) call abort
 119   if (any (minloc (a, mask = l5).ne.(/ 1, 3 /))) call abort
 120 end