t/op/cmp.t

   1 #!./perl
   2
   3 BEGIN {
   4        chdir 't' if -d 't';
   5        @INC = '../lib';
   6 }
   7
   8 # 2s complement assumption. Won't break test, just makes the internals of
   9 # the SVs less interesting if were not on 2s complement system.
  10 my $uv_max = ~0;
  11 my $uv_maxm1 = ~0 ^ 1;
  12 my $uv_big = $uv_max;
  13 $uv_big = ($uv_big - 20000) | 1;
  14 my ($iv0, $iv1, $ivm1, $iv_min, $iv_max, $iv_big, $iv_small);
  15 $iv_max = $uv_max; # Do copy, *then* divide
  16 $iv_max /= 2;
  17 $iv_min = $iv_max;
  18 {
  19   use integer;
  20   $iv0 = 2 - 2;
  21   $iv1 = 3 - 2;
  22   $ivm1 = 2 - 3;
  23   $iv_max -= 1;
  24   $iv_min += 0;
  25   $iv_big = $iv_max - 3;
  26   $iv_small = $iv_min + 2;
  27 }
  28 my $uv_bigi = $iv_big;
  29 $uv_bigi |= 0x0;
  30
  31 my @array = qw(perl rules);
  32
  33 # Seems one needs to perform the maths on 'Inf' to get the NV correctly primed.
  34 @FOO = ('s', 'N/A', 'a', 'NaN', -1, undef, 0, 1, 3.14, 1e37, 0.632120558, -.5,
  35         'Inf'+1, '-Inf'-1, 0x0, 0x1, 0x5, 0xFFFFFFFF, $uv_max, $uv_maxm1,
  36         $uv_big, $uv_bigi, $iv0, $iv1, $ivm1, $iv_min, $iv_max, $iv_big,
  37         $iv_small, \$array[0], \$array[0], \$array[1], \$^X);
  38
  39 $expect = 7 * ($#FOO+2) * ($#FOO+1);
  40 print "1..$expect\n";
  41
  42 sub nok ($$$$$$$$) {
  43   my ($test, $left, $threeway, $right, $result, $i, $j, $boolean) = @_;
  44   $result = defined $result ? "'$result'" : 'undef';
  45   print "not ok $test # ($left <=> $right) gives: $result \$i=$i \$j=$j, $boolean disagrees\n";
  46 }
  47
  48 my $ok = 0;
  49 for my $i (0..$#FOO) {
  50     for my $j ($i..$#FOO) {
  51         $ok++;
  52         # Comparison routines may convert these internally, which would change
  53         # what is used to determine the comparison on later runs. Hence copy
  54         my ($i1, $i2, $i3, $i4, $i5, $i6, $i7, $i8, $i9, $i10,
  55             $i11, $i12, $i13, $i14, $i15, $i16, $i17) =
  56           ($FOO[$i], $FOO[$i], $FOO[$i], $FOO[$i], $FOO[$i], $FOO[$i],
  57            $FOO[$i], $FOO[$i], $FOO[$i], $FOO[$i], $FOO[$i], $FOO[$i],
  58            $FOO[$i], $FOO[$i], $FOO[$i], $FOO[$i], $FOO[$i]);
  59         my ($j1, $j2, $j3, $j4, $j5, $j6, $j7, $j8, $j9, $j10,
  60             $j11, $j12, $j13, $j14, $j15, $j16, $j17) =
  61           ($FOO[$j], $FOO[$j], $FOO[$j], $FOO[$j], $FOO[$j], $FOO[$j],
  62            $FOO[$j], $FOO[$j], $FOO[$j], $FOO[$j], $FOO[$j], $FOO[$j],
  63            $FOO[$j], $FOO[$j], $FOO[$j], $FOO[$j], $FOO[$j]);
  64         my $cmp = $i1 <=> $j1;
  65         if (!defined($cmp) ? !($i2 < $j2)
  66             : ($cmp == -1 && $i2 < $j2 ||
  67                $cmp == 0  && !($i2 < $j2) ||
  68                $cmp == 1  && !($i2 < $j2)))
  69         {
  70             print "ok $ok\n";
  71         }
  72         else {
  73             nok ($ok, $i3, '<=>', $j3, $cmp, $i, $j, '<');
  74         }
  75         $ok++;
  76         if (!defined($cmp) ? !($i4 == $j4)
  77             : ($cmp == -1 && !($i4 == $j4) ||
  78                $cmp == 0  && $i4 == $j4 ||
  79                $cmp == 1  && !($i4 == $j4)))
  80         {
  81             print "ok $ok\n";
  82         }
  83         else {
  84             nok ($ok, $i3, '<=>', $j3, $cmp, $i, $j, '==');
  85         }
  86         $ok++;
  87         if (!defined($cmp) ? !($i5 > $j5)
  88             : ($cmp == -1 && !($i5 > $j5) ||
  89                $cmp == 0  && !($i5 > $j5) ||
  90                $cmp == 1  && ($i5 > $j5)))
  91         {
  92             print "ok $ok\n";
  93         }
  94         else {
  95             nok ($ok, $i3, '<=>', $j3, $cmp, $i, $j, '>');
  96         }
  97         $ok++;
  98         if (!defined($cmp) ? !($i6 >= $j6)
  99             : ($cmp == -1 && !($i6 >= $j6) ||
 100                $cmp == 0  && $i6 >= $j6 ||
 101                $cmp == 1  && $i6 >= $j6))
 102         {
 103             print "ok $ok\n";
 104         }
 105         else {
 106             nok ($ok, $i3, '<=>', $j3, $cmp, $i, $j, '>=');
 107         }
 108         $ok++;
 109         # OK, so the docs are wrong it seems. NaN != NaN
 110         if (!defined($cmp) ? ($i7 != $j7)
 111             : ($cmp == -1 && $i7 != $j7 ||
 112                $cmp == 0  && !($i7 != $j7) ||
 113                $cmp == 1  && $i7 != $j7))
 114         {
 115             print "ok $ok\n";
 116         }
 117         else {
 118             nok ($ok, $i3, '<=>', $j3, $cmp, $i, $j, '!=');
 119         }
 120         $ok++;
 121         if (!defined($cmp) ? !($i8 <= $j8)
 122             : ($cmp == -1 && $i8 <= $j8 ||
 123                $cmp == 0  && $i8 <= $j8 ||
 124                $cmp == 1  && !($i8 <= $j8)))
 125         {
 126             print "ok $ok\n";
 127         }
 128         else {
 129             nok ($ok, $i3, '<=>', $j3, $cmp, $i, $j, '<=');
 130         }
 131         $ok++;
 132         my $pmc =  $j16 <=> $i16; # cmp it in reverse
 133         # Should give -ve of other answer, or undef for NaNs
 134         # a + -a should be zero. not zero is truth. which avoids using ==
 135         if (defined($cmp) ? !($cmp + $pmc) : !defined $pmc)
 136         {
 137             print "ok $ok\n";
 138         }
 139         else {
 140             nok ($ok, $i3, '<=>', $j3, $cmp, $i, $j, '<=> transposed');
 141         }
 142
 143
 144         # String comparisons
 145         $ok++;
 146         $cmp = $i9 cmp $j9;
 147         if ($cmp == -1 && $i10 lt $j10 ||
 148             $cmp == 0  && !($i10 lt $j10) ||
 149             $cmp == 1  && !($i10 lt $j10))
 150         {
 151             print "ok $ok\n";
 152         }
 153         else {
 154             nok ($ok, $i3, 'cmp', $j3, $cmp, $i, $j, 'lt');
 155         }
 156         $ok++;
 157         if ($cmp == -1 && !($i11 eq $j11) ||
 158             $cmp == 0  && ($i11 eq $j11) ||
 159             $cmp == 1  && !($i11 eq $j11))
 160         {
 161             print "ok $ok\n";
 162         }
 163         else {
 164             nok ($ok, $i3, 'cmp', $j3, $cmp, $i, $j, 'eq');
 165         }
 166         $ok++;
 167         if ($cmp == -1 && !($i12 gt $j12) ||
 168             $cmp == 0  && !($i12 gt $j12) ||
 169             $cmp == 1  && ($i12 gt $j12))
 170         {
 171             print "ok $ok\n";
 172         }
 173         else {
 174             nok ($ok, $i3, 'cmp', $j3, $cmp, $i, $j, 'gt');
 175         }
 176         $ok++;
 177         if ($cmp == -1 && $i13 le $j13 ||
 178             $cmp == 0  && ($i13 le $j13) ||
 179             $cmp == 1  && !($i13 le $j13))
 180         {
 181             print "ok $ok\n";
 182         }
 183         else {
 184             nok ($ok, $i3, 'cmp', $j3, $cmp, $i, $j, 'le');
 185         }
 186         $ok++;
 187         if ($cmp == -1 && ($i14 ne $j14) ||
 188             $cmp == 0  && !($i14 ne $j14) ||
 189             $cmp == 1  && ($i14 ne $j14))
 190         {
 191             print "ok $ok\n";
 192         }
 193         else {
 194             nok ($ok, $i3, 'cmp', $j3, $cmp, $i, $j, 'ne');
 195         }
 196         $ok++;
 197         if ($cmp == -1 && !($i15 ge $j15) ||
 198             $cmp == 0  && ($i15 ge $j15) ||
 199             $cmp == 1  && ($i15 ge $j15))
 200         {
 201             print "ok $ok\n";
 202         }
 203         else {
 204             nok ($ok, $i3, 'cmp', $j3, $cmp, $i, $j, 'ge');
 205         }
 206         $ok++;
 207         $pmc =  $j17 cmp $i17; # cmp it in reverse
 208         # Should give -ve of other answer
 209         # a + -a should be zero. not zero is truth. which avoids using ==
 210         if (!($cmp + $pmc))
 211         {
 212             print "ok $ok\n";
 213         }
 214         else {
 215             nok ($ok, $i3, '<=>', $j3, $cmp, $i, $j, 'cmp transposed');
 216         }
 217     }
 218 }