t/op/my_stash.t should use test.pl instead of Test.pm

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

diff --git a/t/op/pack.t b/t/op/pack.t
old mode 100755 (executable)
new mode 100644 (file)
index 57c6a64..4b5f9a5
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -43,7 +43,7 @@ if ($no_signedness) {
 }
 
 for my $size ( 16, 32, 64 ) {
-  if (defined $Config{"u${size}size"} and $Config{"u${size}size"} != ($size >> 3)) {
+  if (defined $Config{"u${size}size"} and ($Config{"u${size}size"}||0) != ($size >> 3)) {
     push @valid_errors, qr/^Perl_my_$maybe_not_avail$size\(\) not available/;
   }
 }
@@ -711,7 +711,10 @@ sub byteorder
       skip "cannot pack '$format' on this perl", 5
         if is_valid_error($@);
 
-      print "# [$value][$nat][$be][$le][$@]\n";
+      {
+        use warnings qw(NONFATAL utf8);
+        print "# [$value][$nat][$be][$le][$@]\n";
+      }
 
       SKIP: {
         skip "cannot compare native byteorder with big-/little-endian", 1
@@ -915,7 +918,7 @@ SKIP: {
 isnt(v1.20.300.4000, sprintf "%vd", pack("C0U*",1,20,300,4000));
 
 my $rslt = $Is_EBCDIC ? "156 67" : "199 162";
-is(join(" ", unpack("C*", chr(0x1e2))), $rslt);
+is(join(" ", unpack("U0 C*", chr(0x1e2))), $rslt);
 
 # does pack U create Unicode?
 is(ord(pack('U', 300)), 300);
@@ -933,9 +936,6 @@ is("@{[unpack('U*', pack('U*', 100, 200))]}", "100 200");
 SKIP: {
     skip "Not for EBCDIC", 4 if $Is_EBCDIC;
 
-    # does unpack C unravel pack U?
-    is("@{[unpack('C*', pack('U*', 100, 200))]}", "100 195 136");
-
     # does pack U0C create Unicode?
     is("@{[pack('U0C*', 100, 195, 136)]}", v100.v200);
 
@@ -1488,7 +1488,7 @@ $_ = pack('c', 65); # 'A' would not be EBCDIC-friendly
 is(unpack('c'), 65, "one-arg unpack (change #18751)"); # defaulting to $_
 
 {
-    my $a = "X\t01234567\n" x 100;
+    my $a = "X\x0901234567\n" x 100; # \t would not be EBCDIC TAB
     my @a = unpack("(a1 c/a)*", $a);
     is(scalar @a, 200,       "[perl #15288]");
     is($a[-1], "01234567\n", "[perl #15288]");
@@ -1516,7 +1516,11 @@ is(unpack('c'), 65, "one-arg unpack (change #18751)"); # defaulting to $_
     is($x[1], $y[1], "checksum advance ok");
 
     # verify that the checksum is not overflowed with C0
-    is(unpack("C0%128U", "abcd"), unpack("U0%128U", "abcd"), "checksum not overflowed");
+    if (ord('A') == 193) {
+       is(unpack("C0%128U", "/bcd"), unpack("U0%128U", "abcd"), "checksum not overflowed");
+    } else {
+       is(unpack("C0%128U", "abcd"), unpack("U0%128U", "abcd"), "checksum not overflowed");
+    }
 }
 
 {
@@ -1531,10 +1535,15 @@ is(unpack('c'), 65, "one-arg unpack (change #18751)"); # defaulting to $_
 {
     # counted length prefixes shouldn't change C0/U0 mode
     # (note the length is actually 0 in this test)
-    is(join(',', unpack("aC/UU",   "b\0\341\277\274")), 'b,8188');
-    is(join(',', unpack("aC/CU",   "b\0\341\277\274")), 'b,8188');
-    is(join(',', unpack("aU0C/UU", "b\0\341\277\274")), 'b,225');
-    is(join(',', unpack("aU0C/CU", "b\0\341\277\274")), 'b,225');
+    if (ord('A') == 193) {
+       is(join(',', unpack("aU0C/UU", "b\0\341\277\274")), 'b,0');
+       is(join(',', unpack("aU0C/CU", "b\0\341\277\274")), 'b,0');
+    } else {
+       is(join(',', unpack("aC/UU",   "b\0\341\277\274")), 'b,8188');
+       is(join(',', unpack("aC/CU",   "b\0\341\277\274")), 'b,8188');
+       is(join(',', unpack("aU0C/UU", "b\0\341\277\274")), 'b,225');
+       is(join(',', unpack("aU0C/CU", "b\0\341\277\274")), 'b,225');
+    }
 }
 
 {
@@ -1636,7 +1645,7 @@ is(unpack('c'), 65, "one-arg unpack (change #18751)"); # defaulting to $_
 }
 
 {
-    # C is *not* neutral
+    # C *is* neutral
     my $down = "\xf8\xf9\xfa\xfb\xfc\xfd\xfe\xff\x05\x06";
     my $up   = $down;
     utf8::upgrade($up);
@@ -1646,7 +1655,7 @@ is(unpack('c'), 65, "one-arg unpack (change #18751)"); # defaulting to $_
     is(pack("C*", @down), $down, "byte join");
 
     my @up   = unpack("C*", $up);
-    my @expect_up = (0xc3, 0xb8, 0xc3, 0xb9, 0xc3, 0xba, 0xc3, 0xbb, 0xc3, 0xbc, 0xc3, 0xbd, 0xc3, 0xbe, 0xc3, 0xbf, 0x05, 0x06);
+    my @expect_up = (0xf8, 0xf9, 0xfa, 0xfb, 0xfc, 0xfd, 0xfe, 0xff, 0x05, 0x06);
     is("@up", "@expect_up", "UTF-8 expand");
     is(pack("U0C0C*", @up), $up, "UTF-8 join");
 }
@@ -1971,3 +1980,8 @@ is(unpack('c'), 65, "one-arg unpack (change #18751)"); # defaulting to $_
     is(unpack('@!4 a*', "\x{301}\x{302}\x{303}\x{304}\x{305}"),
        "\x{303}\x{304}\x{305}", 'Test basic utf8 @!');
 }
+{
+    #50256
+    my ($v) = split //, unpack ('(B)*', 'ab');
+    is($v, 0); # Doesn't SEGV :-)
+}