[patch: perl@8211]VMS: add -Duseperlio capacity to configure.com
[p5sagit/p5-mst-13.2.git] / t / op / numconvert.t
index 405f721..3db280b 100755 (executable)
@@ -42,23 +42,22 @@ BEGIN {
 
 use strict 'vars';
 
-my $max_chain = $ENV{PERL_TEST_NUMCONVERTS};
-unless (defined $max_chain) {
-  my $is_debug;
-  eval <<'EOE';
-    use Config;
-    $is_debug = 1 if $Config{ccflags} =~ /-DDEBUGGING\b/;
-EOE
-  $max_chain = $is_debug ? 3 : 2;
-}
+my $max_chain = $ENV{PERL_TEST_NUMCONVERTS} || 2;
 
 # Bulk out if unsigned type is hopelessly wrong:
 my $max_uv1 = ~0;
 my $max_uv2 = sprintf "%u", $max_uv1 ** 6; # 6 is an arbitrary number here
 my $big_iv = do {use integer; $max_uv1 * 16}; # 16 is an arbitrary number here
 
+print "# max_uv1 = $max_uv1, max_uv2 = $max_uv2, big_iv = $big_iv\n";
 if ($max_uv1 ne $max_uv2 or $big_iv > $max_uv1) {
-  print "1..0\n# Unsigned arithmetic is not sane\n";
+  print "1..0 # skipped: unsigned perl arithmetic is not sane";
+  eval { require Config; import Config };
+  use vars qw(%Config);
+  if ($Config{d_quad} eq 'define') {
+      print " (common in 64-bit platforms)";
+  }
+  print "\n";
   exit 0;
 }
 
@@ -86,8 +85,15 @@ my @list = (1, $yet_smaller_than_iv, $smaller_than_iv, $max_iv, $max_iv + 1,
 unshift @list, (reverse map -$_, @list), 0; # 15 elts
 @list = map "$_", @list; # Normalize
 
-# print "@list\n";
+print "# @list\n";
+
+# need to special case ++ for max_uv, as ++ "magic" on a string gives
+# another string, whereas ++ magic on a string used as a number gives
+# a number. Not a problem when NV preserves UV, but if it doesn't then
+# stringification of the latter gives something in e notation.
 
+my $max_uv_pp = "$max_uv"; $max_uv_pp++;
+my $max_uv_p1 = "$max_uv"; $max_uv_p1+=0; $max_uv_p1++;
 
 my @opnames = split //, "-+UINPuinp";
 
@@ -179,9 +185,18 @@ for my $num_chain (1..$max_chain) {
            }
            push @ans, $inpt;
          }
-         $nok++,
-           print "# '$ans[0]' ne '$ans[1]',\t$num\t=> @opnames[$first,@{$curops[0]},$last] vs @opnames[$first,@{$curops[1]},$last]\n"
-             if $ans[0] ne $ans[1];
+         if ($ans[0] ne $ans[1]) {
+           print "# '$ans[0]' ne '$ans[1]',\t$num\t=> @opnames[$first,@{$curops[0]},$last] vs @opnames[$first,@{$curops[1]},$last]\n";
+           # XXX ought to check that "+" was in the list of opnames
+           if ((($ans[0] eq $max_uv_pp) and ($ans[1] eq $max_uv_p1))
+               or (($ans[1] eq $max_uv_pp) and ($ans[0] eq $max_uv_p1))) {
+             # string ++ versus numeric ++. Tolerate this little
+             # bit of insanity
+             print "# ok, as string ++ of max_uv is \"$max_uv_pp\", numeric is $max_uv_p1\n"
+           } else {
+             $nok++,
+           }
+         }
        }
        print "not " if $nok;
        print "ok $test\n";