my $no_signedness = $] > 5.009 ? '' :
"Signed/unsigned pack modifiers not available on this perl";
-plan tests => 14708;
+plan tests => 14713;
use strict;
use warnings qw(FATAL all);
# Is this a stupid thing to do on VMS, VOS and other unusual platforms?
skip("-- the IEEE infinity model is unavailable in this configuration.", 1)
- if (($^O eq 'VMS') && !defined($Config{useieee}));
+ if (($^O eq 'VMS') && !defined($Config{useieee}) || !$Config{d_double_has_inf});
skip("-- $^O has serious fp indigestion on w-packed infinities", 1)
if (
SKIP: {
skip("-- the full range of an IEEE double may not be available in this configuration.", 3)
- if (($^O eq 'VMS') && !defined($Config{useieee}));
+ if (($^O eq 'VMS') && !defined($Config{useieee}) || !$Config{d_double_style_ieee});
skip("-- $^O does not like 2**1023", 3)
if (($^O eq 'ultrix'));
# is unpack U the reverse of pack U for byte string?
is("@{[unpack('U*', pack('U*', 100, 200))]}", "100 200");
-
-SKIP: {
- skip "Two of these still fail on EBCDIC; investigate in v5.23", 3 if $::IS_EBCDIC;
-
+{
# does pack U0C create Unicode?
my $cp202 = chr(202);
utf8::upgrade $cp202;
use bytes;
@bytes202 = map { ord } split "", $cp202;
}
- is("@{[pack('U0C*', 100, @bytes202)]}", v100.v202);
+
+ # This test requires the first number to be invariant; 64 is invariant on
+ # ASCII and EBCDIC.
+ is("@{[pack('U0C*', 64, @bytes202)]}", v64.v202);
# does pack C0U create characters?
- is("@{[pack('C0U*', 100, 202)]}", pack("C*", 100, @bytes202));
+ # The U* is expecting Unicode, so convert to that.
+ is("@{[pack('C0U*', map { utf8::native_to_unicode($_) } 64, 202)]}",
+ pack("C*", 64, @bytes202));
# does unpack U0U on byte data warn?
{
my $bad = pack("U0C", 202);
local $SIG{__WARN__} = sub { $@ = "@_" };
my @null = unpack('U0U', $bad);
- like($@, qr/^Malformed UTF-8 character /);
+ like($@, qr/^Malformed UTF-8 character: /);
}
}
| [Bb] (?{ '101' })
| [Hh] (?{ 'b8' })
| [svnSiIlVNLqQjJ] (?{ 10111 })
- | [FfDd] (?{ 1.36514538e67 })
+ | [FfDd] (?{ 1.36514538e37 })
| [pP] (?{ "try this buffer" })
/x; $^R } @codes;
my @end = (0x12345678, 0x23456781, 0x35465768, 0x15263748);
my @b = unpack "$t X[$t] $t", $p; # Extract, step back, extract again
is(scalar @b, 2 * scalar @a);
$b = "@b";
- $b =~ s/(?:17000+|16999+)\d+(e-45) /17$1 /gi; # stringification is gamble
+ $b =~ s/(?:17000+|16999+)\d+(e-0?45) /17$1 /gi; # stringification is gamble
is($b, "@a @a");
use warnings qw(NONFATAL all);;
is($warning, undef);
is(scalar @b, scalar @a);
$b = "@b";
- $b =~ s/(?:17000+|16999+)\d+(e-45) /17$1 /gi; # stringification is gamble
+ $b =~ s/(?:17000+|16999+)\d+(e-0?45) /17$1 /gi; # stringification is gamble
is($b, "@a");
}
my (@y) = unpack("%b10a", "abcd");
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");
+ SKIP: {
+ skip("-- non-IEEE float", 1) if !$Config{d_double_style_ieee};
+ # verify that the checksum is not overflowed with C0
+ is(unpack("C0%128U", "abcd"), unpack("U0%128U", "abcd"), "checksum not overflowed");
+ }
}
my $U_1FFC_bytes = byte_utf8a_to_utf8n("\341\277\274");
-my $first_byte = ord uni_to_native("\341");
{
# U0 and C0 must be scoped
my (@x) = unpack("a(U0)U", "b$U_1FFC_bytes");
is(pack("a(U0)U", "b", 8188), "b$U_1FFC_bytes");
}
-SKIP:
{
# counted length prefixes shouldn't change C0/U0 mode
# (note the length is actually 0 in this test, as the C/ is replaced by C0
# due to the \0 in the string)
is(join(',', unpack("aC/UU", "b\0$U_1FFC_bytes")), 'b,8188');
is(join(',', unpack("aC/CU", "b\0$U_1FFC_bytes")), 'b,8188');
- skip "These two still fail on EBCDIC; investigate in v5.23", 2 if $::IS_EBCDIC;
+
+ # The U expects Unicode, so convert from native
+ my $first_byte = utf8::native_to_unicode(ord substr($U_1FFC_bytes, 0, 1));
+
is(join(',', unpack("aU0C/UU", "b\0$U_1FFC_bytes")), "b,$first_byte");
is(join(',', unpack("aU0C/CU", "b\0$U_1FFC_bytes")), "b,$first_byte");
}
#[perl #123874]: argument underflow leads to corrupt length
eval q{ pack "pi/x" };
ok(1, "argument underflow did not crash");
+
+{
+ # [perl #126325] pack [hH] with a unicode string
+ # the hex encoders would read past the end of the string, using
+ # invalid source bytes
+ my $twenty_nuls = "\0" x 20;
+ # This is the case that failed
+ is(pack("WH40", 0x100, ""), "\x{100}$twenty_nuls",
+ "check pack H zero fills (utf8 target)");
+ my $up_nul = "\0";
+
+ utf8::upgrade($up_nul);
+ # check the other combinations too
+ is(pack("WH40", 0x100, $up_nul), "\x{100}$twenty_nuls",
+ "check pack H zero fills (utf8 target/source)");
+ is(pack("H40", ""), $twenty_nuls,
+ "check pack H zero fills (utf8 none)");
+ is(pack("H40", $up_nul), $twenty_nuls,
+ "check pack H zero fills (utf8 source)");
+}
+
+SKIP:
+{
+ # [perl #129149] the code below would write one past the end of the output
+ # buffer, only detected by ASAN, not by valgrind
+ $Config{ivsize} >= 8
+ or skip "[perl #129149] need 64-bit for this test", 1;
+ fresh_perl_is(<<'EOS', "ok\n", { stderr => 1 }, "pack W overflow");
+print pack("ucW", "0000", 0, 140737488355327) eq "\$,#`P,```\n\0\x{7fffffffffff}"
+ ? "ok\n" : "not ok\n";
+EOS
+}