Fix bug in DynaLoader, which has been passing a filename in dynamic

[p5sagit/p5-mst-13.2.git] / pp_pack.c

diff --git a/pp_pack.c b/pp_pack.c
index 97e22fd..5deede9 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -2359,28 +2359,6 @@ S_div128(pTHX_ SV *pnum, bool *done)
 }
 
 /*
-=for apidoc pack_cat
-
-The engine implementing pack() Perl function. Note: parameters next_in_list and
-flags are not used. This call should not be used; use packlist instead.
-
-=cut
-*/
-
-void
-Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist, SV ***next_in_list, U32 flags)
-{
-    tempsym_t sym;
-    PERL_UNUSED_ARG(next_in_list);
-    PERL_UNUSED_ARG(flags);
-
-    TEMPSYM_INIT(&sym, pat, patend, FLAG_PACK);
-
-    (void)pack_rec( cat, &sym, beglist, endlist );
-}
-
-
-/*
 =for apidoc packlist
 
 The engine implementing pack() Perl function.
@@ -2392,14 +2370,13 @@ void
 Perl_packlist(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist )
 {
     dVAR;
-    STRLEN no_len;
     tempsym_t sym;
 
     TEMPSYM_INIT(&sym, pat, patend, FLAG_PACK);
 
     /* We're going to do changes through SvPVX(cat). Make sure it's valid.
        Also make sure any UTF8 flag is loaded */
-    SvPV_force(cat, no_len);
+    SvPV_force_nolen(cat);
     if (DO_UTF8(cat))
        sym.flags |= FLAG_PARSE_UTF8 | FLAG_DO_UTF8;
 
@@ -2544,9 +2521,20 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            if (strchr("aAZ", lookahead.code)) {
                if (lookahead.howlen == e_number) count = lookahead.length;
                else {
-                   if (items > 0)
+                   if (items > 0) {
+                       if (SvGAMAGIC(*beglist)) {
+                           /* Avoid reading the active data more than once
+                              by copying it to a temporary.  */
+                           STRLEN len;
+                           const char *const pv = SvPV_const(*beglist, len);
+                           SV *const temp = sv_2mortal(newSVpvn(pv, len));
+                           if (SvUTF8(*beglist))
+                               SvUTF8_on(temp);
+                           *beglist = temp;
+                       }
                        count = DO_UTF8(*beglist) ?
                            sv_len_utf8(*beglist) : sv_len(*beglist);
+                   }
                    else count = 0;
                    if (lookahead.code == 'Z') count++;
                }