X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Fpack.t;h=4b5f9a5bc5abe26a009462b10039133ae1ddd8d5;hb=ae533554a9c124f574bc4e6f57c895308d938681;hp=d58a87d63c3abdd12149565947d792d9c536731f;hpb=250d67eb8e42c118b44bb5437965a1f4a8a0d828;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/op/pack.t b/t/op/pack.t old mode 100755 new mode 100644 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 :-) +}