my $no_signedness = $] > 5.009 ? '' :
"Signed/unsigned pack modifiers not available on this perl";
-plan tests => 14697;
+plan tests => 14696;
use strict;
use warnings qw(FATAL all);
}
for my $size ( 16, 32, 64 ) {
- if (exists $Config{"u${size}size"} and $Config{"u${size}size"} != ($size >> 3)) {
+ if (defined $Config{"u${size}size"} and $Config{"u${size}size"} != ($size >> 3)) {
push @valid_errors, qr/^Perl_my_$maybe_not_avail$size\(\) not available/;
}
}
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
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);
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);
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]");
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");
+ }
}
{
{
# 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');
+ }
}
{
}
{
- # 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);
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");
}