Add a TODO test for block evals segfaulting on syntax errors.

[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 d58a87d..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);
 
@@ -1645,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);
@@ -1655,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");
 }
@@ -1980,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 :-)
+}