Integrate mainline

[p5sagit/p5-mst-13.2.git] / t / op / sprintf.t

diff --git a/t/op/sprintf.t b/t/op/sprintf.t
index 0c2400c..97b66a5 100755 (executable)
--- a/t/op/sprintf.t
+++ b/t/op/sprintf.t
@@ -8,7 +8,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
+    @INC = '../lib';
 }   
 use warnings;
 
@@ -34,29 +34,46 @@ for ($i = 1; @tests; $i++) {
     $x = sprintf(">$template<",
                  defined @$evalData ? @$evalData : $evalData);
     substr($x, -1, 0) = $w if $w;
-    # $y may have 3 exponent digits, not 2
-    my $r;
-    if (($y = $x) =~ s/([Ee][-+])0(\d)/$1$2/g) {
-       $y =~ s/^>\s+/>/;
-       $y =~ s/\s+<$/</;
-       $r = $result;
-       $r =~ s/^\s+//;
-       $r =~ s/\s+$//;
+    # $x may have 3 exponent digits, not 2
+    my $y = $x;
+    if ($y =~ s/([Ee][-+])0(\d)/$1$2/) {
+        # if result is left-adjusted, append extra space
+        if ($template =~ /%\+?\-/ and $result =~ / $/) {
+           $y =~ s/<$/ </;
+       }
+        # if result is zero-filled, add extra zero
+       elsif ($template =~ /%\+?0/ and $result =~ /^0/) {
+           $y =~ s/^>0/>00/;
+       }
+        # if result is right-adjusted, prepend extra space
+       elsif ($result =~ /^ /) {
+           $y =~ s/^>/> /;
+       }
     }
 
     if ($x eq ">$result<") {
         print "ok $i\n";
     }
-    elsif ($r and $y eq ">$r<")        # Some C libraries always give
+    elsif ($y eq ">$result<")  # Some C libraries always give
     {                          # three-digit exponent
-       print("ok $i >$result< $x # three-digit exponent accepted\n");
+               print("ok $i # >$result< $x three-digit exponent accepted\n");
     }
+       elsif ($result =~ /[-+]\d{3}$/ &&
+                  # Suppress tests with modulo of exponent >= 100 on platforms
+                  # which can't handle such magnitudes (or where we can't tell).
+                  ((!eval {require POSIX}) || # Costly: only do this if we must!
+                       (length(&POSIX::DBL_MAX) - rindex(&POSIX::DBL_MAX, '+')) == 3))
+       {
+               print("ok $i # >$template< >$data< >$result<",
+                         " Suppressed: exponent out of range?\n") 
+       }
     else {
-       print("not ok $i >$template< >$data< >$result< $x",
+       $y = ($x eq $y ? "" : " => $y");
+       print("not ok $i >$template< >$data< >$result< $x$y",
            $comment ? " # $comment\n" : "\n");
     }
 }
-    
+
 # In each of the the following lines, there are three required fields:
 # printf template, data to be formatted (as a Perl expression), and
 # expected result of formatting.  An optional fourth field can contain
@@ -68,6 +85,20 @@ for ($i = 1; @tests; $i++) {
 # number of elements.  Even so, subterfuge is sometimes required: see
 # tests for %n and %p.
 #
+# The following tests are not currently run, for the reasons stated:
+
+=pod
+
+=begin problematic
+
+>%.0f<      >-0.1<        >-0<  >C library bug: no minus on VMS, HP-UX<
+>%.0f<      >1.5<         >2<   >Standard vague: no rounding rules<
+>%.0f<      >2.5<         >2<   >Standard vague: no rounding rules<
+
+=end problematic
+
+=cut
+
 # template    data          result
 __END__
 >%6. 6s<    >''<          >%6. 6s INVALID< >(See use of $w in code above)<
@@ -149,7 +180,14 @@ __END__
 >%v+-3d<    >"\01\02\03"< >+1 .2  .3  <
 >%v4.3d<    >"\01\02\03"< > 001. 002. 003<
 >%v04.3d<   >"\01\02\03"< >0001.0002.0003<
->%*v02d<    >['-', "\0\7\13"]< >00-07-11<
+>%*v02d<    >['-', "\0\7\14"]< >00-07-12<
+>%v.*d<     >[3, "\01\02\03"]< >001.002.003<
+>%v0*d<     >[3, "\01\02\03"]< >001.002.003<
+>%v-*d<     >[3, "\01\02\03"]< >1  .2  .3  <
+>%v+-*d<    >[3, "\01\02\03"]< >+1 .2  .3  <
+>%v*.*d<    >[4, 3, "\01\02\03"]< > 001. 002. 003<
+>%v0*.*d<   >[4, 3, "\01\02\03"]< >0001.0002.0003<
+>%*v0*d<    >['-', 2, "\0\7\13"]< >00-07-11<
 >%e<        >1234.875<    >1.234875e+03<
 >%e<        >0.000012345< >1.234500e-05<
 >%e<        >1234567E96<  >1.234567e+102<
@@ -161,6 +199,7 @@ __END__
 >%+e<       >-1234.875<   >-1.234875e+03<
 >%#e<       >-1234.875<   >-1.234875e+03<
 >%.0e<      >1234.875<    >1e+03<
+>%#.0e<     >1234.875<    >1.e+03<
 >%.*e<      >[0, 1234.875]< >1e+03<
 >%.1e<      >1234.875<    >1.2e+03<
 >%-12.4e<   >1234.875<    >1.2349e+03  <
@@ -189,12 +228,16 @@ __END__
 >%f<        >0<           >0.000000<
 >%.0f<      >0<           >0<
 >%.0f<      >2**38<       >274877906944<   >Should have exact int'l rep'n<
->%.0f<      >0.5<         >0<
->%.0f<      >-0.5<        >-0<
+>%.0f<      >0.1<         >0<
+>%.0f<      >0.6<         >1<              >Known to fail with sfio<
+>%.0f<      >-0.6<        >-1<             >Known to fail with sfio<
+>%.0f<      >1<           >1<
+>%#.0f<     >1<           >1.<
 >%g<        >12345.6789<  >12345.7<
 >%+g<       >12345.6789<  >+12345.7<
 >%#g<       >12345.6789<  >12345.7<
 >%.0g<      >12345.6789<  >1e+04<
+>%#.0g<     >12345.6789<  >1.e+04<
 >%.2g<      >12345.6789<  >1.2e+04<
 >%.*g<      >[2, 12345.6789]< >1.2e+04<
 >%.9g<      >12345.6789<  >12345.6789<
@@ -231,6 +274,7 @@ __END__
 >%+o<       >2**32-1<     >37777777777<
 >%#o<       >2**32-1<     >037777777777<
 >%d< >$p=sprintf('%p',$p);$p=~/^[0-9a-f]+$/< >1< >Coarse hack: hex from %p?<
+>%#p<       >''<          >%#p INVALID<
 >%q<        >''<          >%q INVALID<
 >%r<        >''<          >%r INVALID<
 >%s<        >'string'<    >string<
@@ -264,3 +308,16 @@ __END__
 >%0*x<      >[-10, ,2**32-1]< >ffffffff  <
 >%y<        >''<          >%y INVALID<
 >%z<        >''<          >%z INVALID<
+>%2$d %1$d<    >[12, 34]<      >34 12<
+>%*2$d<                >[12, 3]<       > 12<
+>%2$d %d<      >[12, 34]<      >34 12<
+>%2$d %d %d<   >[12, 34]<      >34 12 34<
+>%3$d %d %d<   >[12, 34, 56]<  >56 12 34<
+>%2$*3$d %d<   >[12, 34, 3]<   > 34 12<
+>%*3$2$d %d<   >[12, 34, 3]<   > 34 12<
+>%2$d<         >12<    >0<
+>%0$d<         >12<    >%0$d INVALID<
+>%1$$d<                >12<    >%1$$d INVALID<
+>%1$1$d<       >12<    >%1$1$d INVALID<
+>%*2$*2$d<     >[12, 3]<       >%*2$*2$d INVALID<
+>%*2*2$d<      >[12, 3]<       >%*2*2$d INVALID<