This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix double FETCH with pack "w"
authorFather Chrysostomos <sprout@cpan.org>
Sat, 27 Sep 2014 21:36:45 +0000 (14:36 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 28 Sep 2014 00:08:36 +0000 (17:08 -0700)
pp_pack.c
t/op/tie_fetch_count.t

index 97ddb27..40db6ef 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -2874,7 +2874,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                if (SvIOK(fromstr) || anv < UV_MAX_P1) {
                    char   buf[(sizeof(UV)*CHAR_BIT)/7+1];
                    char  *in = buf + sizeof(buf);
-                   UV     auv = SvUV(fromstr);
+                   UV     auv = SvUV_nomg(fromstr);
 
                    do {
                        *--in = (char)((auv & 0x7f) | 0x80);
@@ -2925,7 +2925,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 
                  w_string:
                    /* Copy string and check for compliance */
-                   from = SvPV_const(fromstr, len);
+                   from = SvPV_nomg_const(fromstr, len);
                    if ((norm = is_an_int(from, len)) == NULL)
                        Perl_croak(aTHX_ "Can only compress unsigned integers in pack");
 
index c97b9b4..5767c86 100644 (file)
@@ -7,7 +7,7 @@ BEGIN {
     chdir 't' if -d 't';
     require './test.pl';
     set_up_inc('../lib');
-    plan (tests => 312);
+    plan (tests => 314);
 }
 
 use strict;
@@ -260,6 +260,11 @@ for ([chdir=>''],[chmod=>'0,'],[chown=>'0,0,'],[utime=>'0,0,'],
 chop(my $u = "\xff\x{100}");
 tie $var, "main", $u;
 $dummy  = pack "u", $var; check_count 'pack "u", $utf8';
+$var = 0;
+$dummy  = pack "w", $var; check_count 'pack "w", $tied_int';
+$var = "111111111111111111111111111111111111111111111111111111111111111";
+$dummy  = eval { pack "w", $var };
+                          check_count 'pack "w", $tied_huge_int_as_str';
 
 tie $var, "main", "\x{100}";
 pos$var = 0             ; check_count 'lvalue pos $utf8';