1#!./perl 2 3BEGIN { 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. 10my $uv_max = ~0; 11my $uv_maxm1 = ~0 ^ 1; 12my $uv_big = $uv_max; 13$uv_big = ($uv_big - 20000) | 1; 14my ($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} 28my $uv_bigi = $iv_big; 29$uv_bigi |= 0x0; 30 31my @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); 40print "1..$expect\n"; 41 42sub 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 48my $ok = 0; 49for 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} 219