diff options
| -rw-r--r-- | pp_pack.c | 2 | ||||
| -rw-r--r-- | t/op/pack.t | 22 |
2 files changed, 22 insertions, 2 deletions
@@ -2488,7 +2488,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) if (howlen == e_star) len = fromlen; field_len = (len+1)/2; GROWING(utf8, cat, start, cur, field_len); - if (!utf8 && len > (I32)fromlen) len = fromlen; + if (!utf8_source && len > (I32)fromlen) len = fromlen; bits = 0; l = 0; if (datumtype == 'H') diff --git a/t/op/pack.t b/t/op/pack.t index e348693bf5..a2da63689b 100644 --- a/t/op/pack.t +++ b/t/op/pack.t @@ -12,7 +12,7 @@ my $no_endianness = $] > 5.009 ? '' : my $no_signedness = $] > 5.009 ? '' : "Signed/unsigned pack modifiers not available on this perl"; -plan tests => 14708; +plan tests => 14712; use strict; use warnings qw(FATAL all); @@ -2024,3 +2024,23 @@ is $o::num, 1, 'pack "c" does call num overloading'; #[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)"); +} |