STRLEN len = 0;
char *name = "";
if (cUNOP->op_first->op_type == OP_PADSV) {
- SV *padname = *av_fetch(PL_comppad_name, cUNOP->op_first->op_targ, 4);
- name = SvPV(padname,len);
+ SV **namep = av_fetch(PL_comppad_name, cUNOP->op_first->op_targ, 4);
+ if (namep && *namep) {
+ name = SvPV(*namep,len);
+ if (!name) {
+ name = "";
+ len = 0;
+ }
+ }
}
- gv_init(gv, PL_curcop->cop_stash, name, len, 0);
+ gv_init(gv, CopSTASH(PL_curcop), name, len, 0);
sv_upgrade(sv, SVt_RV);
SvRV(sv) = (SV *) gv;
SvROK_on(sv);
HV *stash;
if (MAXARG == 1)
- stash = PL_curcop->cop_stash;
+ stash = CopSTASH(PL_curcop);
else {
SV *ssv = POPs;
STRLEN len;
Newz(602, gp, 1, GP);
GvGP(sv) = gp_ref(gp);
GvSV(sv) = NEWSV(72,0);
- GvLINE(sv) = PL_curcop->cop_line;
+ GvLINE(sv) = CopLINE(PL_curcop);
GvEGV(sv) = (GV*)sv;
GvMULTI_on(sv);
}
register U32 culong;
NV cdouble;
int commas = 0;
+ int star;
#ifdef PERL_NATINT_PACK
int natint; /* native integer */
int unatint; /* unsigned native integer */
else
DIE(aTHX_ "'!' allowed only after types %s", natstr);
}
+ star = 0;
if (pat >= patend)
len = 1;
else if (*pat == '*') {
len = strend - strbeg; /* long enough */
pat++;
+ star = 1;
}
else if (isDIGIT(*pat)) {
len = *pat++ - '0';
}
else
len = (datumtype != '@');
+ redo_switch:
switch(datumtype) {
default:
DIE(aTHX_ "Invalid type in unpack: '%c'", (int)datumtype);
case '/':
if (oldsp >= SP)
DIE(aTHX_ "/ must follow a numeric type");
- if (*pat != 'a' && *pat != 'A' && *pat != 'Z')
- DIE(aTHX_ "/ must be followed by a, A or Z");
datumtype = *pat++;
if (*pat == '*')
pat++; /* ignore '*' for compatibility with pack */
if (isDIGIT(*pat))
DIE(aTHX_ "/ cannot take a count" );
len = POPi;
- /* drop through */
+ star = 0;
+ goto redo_switch;
case 'A':
case 'Z':
case 'a':
break;
case 'B':
case 'b':
- if (pat[-1] == '*' || len > (strend - s) * 8)
+ if (star || len > (strend - s) * 8)
len = (strend - s) * 8;
if (checksum) {
if (!PL_bitcount) {
break;
case 'H':
case 'h':
- if (pat[-1] == '*' || len > (strend - s) * 2)
+ if (star || len > (strend - s) * 2)
len = (strend - s) * 2;
sv = NEWSV(35, len + 1);
SvCUR_set(sv, len);
case 'a':
fromstr = NEXTFROM;
aptr = SvPV(fromstr, fromlen);
- if (pat[-1] == '*')
+ if (pat[-1] == '*') {
len = fromlen;
- if (fromlen > len)
+ if (datumtype == 'Z')
+ ++len;
+ }
+ if (fromlen >= len) {
sv_catpvn(cat, aptr, len);
+ if (datumtype == 'Z')
+ *(SvEND(cat)-1) = '\0';
+ }
else {
sv_catpvn(cat, aptr, fromlen);
len -= fromlen;
sv_catpvn(cat, (char*)&aquad, sizeof(Quad_t));
}
break;
-#endif /* HAS_QUAD */
+#endif
case 'P':
len = 1; /* assume SV is correct length */
/* FALL THROUGH */
TAINT_IF((pm->op_pmflags & PMf_LOCALE) &&
(pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE)));
- if (pm->op_pmreplroot)
+ if (pm->op_pmreplroot) {
+#ifdef USE_ITHREADS
+ ary = GvAVn((GV*)PL_curpad[(PADOFFSET)pm->op_pmreplroot]);
+#else
ary = GvAVn((GV*)pm->op_pmreplroot);
+#endif
+ }
else if (gimme != G_ARRAY)
#ifdef USE_THREADS
ary = (AV*)PL_curpad[0];
Perl_croak(aTHX_ "panic: unlock_condpair unlocking mutex that we don't own");
MgOWNER(mg) = 0;
COND_SIGNAL(MgOWNERCONDP(mg));
- DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: unlock 0x%lx\n",
- (unsigned long)thr, (unsigned long)svv);)
+ DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": unlock 0x%"UVxf"\n",
+ PTR2UV(thr), PTR2UV(svv));)
MUTEX_UNLOCK(MgMUTEXP(mg));
}
#endif /* USE_THREADS */
while (MgOWNER(mg))
COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
MgOWNER(mg) = thr;
- DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n",
- (unsigned long)thr, (unsigned long)sv);)
+ DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": pp_lock lock 0x%"UVxf"\n",
+ PTR2UV(thr), PTR2UV(sv));)
MUTEX_UNLOCK(MgMUTEXP(mg));
- SAVEDESTRUCTOR(Perl_unlock_condpair, sv);
+ SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
}
#endif /* USE_THREADS */
if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV