* NI-S 1999/05/07
*/
if (PL_op->op_private & OPpDEREF) {
- GV *gv = (GV *) newSV(0);
- STRLEN len = 0;
- char *name = "";
- if (cUNOP->op_first->op_type == OP_PADSV) {
- 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;
- }
- }
+ char *name;
+ GV *gv;
+ if (cUNOP->op_targ) {
+ STRLEN len;
+ SV *namesv = PL_curpad[cUNOP->op_targ];
+ name = SvPV(namesv, len);
+ gv = (GV*)NEWSV(0,0);
+ gv_init(gv, CopSTASH(PL_curcop), name, len, 0);
+ }
+ else {
+ name = CopSTASHPV(PL_curcop);
+ gv = newGVgen(name);
}
- gv_init(gv, CopSTASH(PL_curcop), name, len, 0);
sv_upgrade(sv, SVt_RV);
- SvRV(sv) = (SV *) gv;
+ SvRV(sv) = (SV*)gv;
SvROK_on(sv);
SvSETMAGIC(sv);
goto wasref;
- }
+ }
if (PL_op->op_flags & OPf_REF ||
PL_op->op_private & HINT_STRICT_REFS)
DIE(aTHX_ PL_no_usym, "a symbol");
if (ckWARN(WARN_UNINITIALIZED))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
RETSETUNDEF;
}
sym = SvPV(sv, n_a);
PL_op->op_private & HINT_STRICT_REFS)
DIE(aTHX_ PL_no_usym, "a SCALAR");
if (ckWARN(WARN_UNINITIALIZED))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
RETSETUNDEF;
}
sym = SvPV(sv, n_a);
sv_pos_u2b(sv, &pos, &rem);
tmps += pos;
sv_setpvn(TARG, tmps, rem);
- if (lvalue) { /* it's an lvalue! */
+ if (repl)
+ sv_insert(sv, pos, rem, repl, repl_len);
+ else if (lvalue) { /* it's an lvalue! */
if (!SvGMAGICAL(sv)) {
if (SvROK(sv)) {
STRLEN n_a;
LvTARGOFF(TARG) = pos;
LvTARGLEN(TARG) = rem;
}
- else if (repl)
- sv_insert(sv, pos, rem, repl, repl_len);
}
SPAGAIN;
PUSHs(TARG); /* avoid SvSETMAGIC here */
tend = uv_to_utf8(tmpbuf, uv);
- if (!SvPADTMP(sv) || tend - tmpbuf != ulen) {
+ if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
dTARGET;
sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
}
}
else {
- if (!SvPADTMP(sv)) {
+ if (!SvPADTMP(sv) || SvREADONLY(sv)) {
dTARGET;
sv_setsv(TARG, sv);
sv = TARG;
tend = uv_to_utf8(tmpbuf, uv);
- if (!SvPADTMP(sv) || tend - tmpbuf != ulen) {
+ if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
dTARGET;
sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
}
}
else {
- if (!SvPADTMP(sv)) {
+ if (!SvPADTMP(sv) || SvREADONLY(sv)) {
dTARGET;
sv_setsv(TARG, sv);
sv = TARG;
}
}
else {
- if (!SvPADTMP(sv)) {
+ if (!SvPADTMP(sv) || SvREADONLY(sv)) {
dTARGET;
sv_setsv(TARG, sv);
sv = TARG;
}
}
else {
- if (!SvPADTMP(sv)) {
+ if (!SvPADTMP(sv) || SvREADONLY(sv)) {
dTARGET;
sv_setsv(TARG, sv);
sv = TARG;
U32 hvtype;
hv = (HV*)POPs;
hvtype = SvTYPE(hv);
- while (++MARK <= SP) {
- if (hvtype == SVt_PVHV)
+ if (hvtype == SVt_PVHV) { /* hash element */
+ while (++MARK <= SP) {
sv = hv_delete_ent(hv, *MARK, discard, 0);
- else
- DIE(aTHX_ "Not a HASH reference");
- *MARK = sv ? sv : &PL_sv_undef;
+ *MARK = sv ? sv : &PL_sv_undef;
+ }
+ }
+ else if (hvtype == SVt_PVAV) {
+ if (PL_op->op_flags & OPf_SPECIAL) { /* array element */
+ while (++MARK <= SP) {
+ sv = av_delete((AV*)hv, SvIV(*MARK), discard);
+ *MARK = sv ? sv : &PL_sv_undef;
+ }
+ }
+ else { /* pseudo-hash element */
+ while (++MARK <= SP) {
+ sv = avhv_delete_ent((AV*)hv, *MARK, discard, 0);
+ *MARK = sv ? sv : &PL_sv_undef;
+ }
+ }
}
+ else
+ DIE(aTHX_ "Not a HASH reference");
if (discard)
SP = ORIGMARK;
else if (gimme == G_SCALAR) {
hv = (HV*)POPs;
if (SvTYPE(hv) == SVt_PVHV)
sv = hv_delete_ent(hv, keysv, discard, 0);
+ else if (SvTYPE(hv) == SVt_PVAV) {
+ if (PL_op->op_flags & OPf_SPECIAL)
+ sv = av_delete((AV*)hv, SvIV(keysv), discard);
+ else
+ sv = avhv_delete_ent((AV*)hv, keysv, discard, 0);
+ }
else
DIE(aTHX_ "Not a HASH reference");
if (!sv)
RETPUSHYES;
}
else if (SvTYPE(hv) == SVt_PVAV) {
- if (avhv_exists_ent((AV*)hv, tmpsv, 0))
+ if (PL_op->op_flags & OPf_SPECIAL) { /* array element */
+ if (av_exists((AV*)hv, SvIV(tmpsv)))
+ RETPUSHYES;
+ }
+ else if (avhv_exists_ent((AV*)hv, tmpsv, 0)) /* pseudo-hash element */
RETPUSHYES;
}
else {
*MARK++ = *SP;
*SP-- = tmp;
}
+ /* safe as long as stack cannot get extended in the above */
SP = oldsp;
}
else {
{
djSP;
dPOPPOPssrl;
- SV **oldsp = SP;
+ I32 start_sp_offset = SP - PL_stack_base;
I32 gimme = GIMME_V;
SV *sv;
STRLEN llen;
I32 datumtype;
register I32 len;
register I32 bits;
+ register char *str;
/* These must not be in registers: */
I16 ashort;
s += len;
break;
case '/':
- if (oldsp >= SP)
+ if (start_sp_offset >= SP - PL_stack_base)
DIE(aTHX_ "/ must follow a numeric type");
datumtype = *pat++;
if (*pat == '*')
sv = NEWSV(35, len + 1);
SvCUR_set(sv, len);
SvPOK_on(sv);
- aptr = pat; /* borrow register */
- pat = SvPVX(sv);
+ str = SvPVX(sv);
if (datumtype == 'b') {
aint = len;
for (len = 0; len < aint; len++) {
bits >>= 1;
else
bits = *s++;
- *pat++ = '0' + (bits & 1);
+ *str++ = '0' + (bits & 1);
}
}
else {
bits <<= 1;
else
bits = *s++;
- *pat++ = '0' + ((bits & 128) != 0);
+ *str++ = '0' + ((bits & 128) != 0);
}
}
- *pat = '\0';
- pat = aptr; /* unborrow register */
+ *str = '\0';
XPUSHs(sv_2mortal(sv));
break;
case 'H':
sv = NEWSV(35, len + 1);
SvCUR_set(sv, len);
SvPOK_on(sv);
- aptr = pat; /* borrow register */
- pat = SvPVX(sv);
+ str = SvPVX(sv);
if (datumtype == 'h') {
aint = len;
for (len = 0; len < aint; len++) {
bits >>= 4;
else
bits = *s++;
- *pat++ = PL_hexdigit[bits & 15];
+ *str++ = PL_hexdigit[bits & 15];
}
}
else {
bits <<= 4;
else
bits = *s++;
- *pat++ = PL_hexdigit[(bits >> 4) & 15];
+ *str++ = PL_hexdigit[(bits >> 4) & 15];
}
}
- *pat = '\0';
- pat = aptr; /* unborrow register */
+ *str = '\0';
XPUSHs(sv_2mortal(sv));
break;
case 'c':
checksum = 0;
}
}
- if (SP == oldsp && gimme == G_SCALAR)
+ if (SP - PL_stack_base == start_sp_offset && gimme == G_SCALAR)
PUSHs(&PL_sv_undef);
RETURN;
}
case 'B':
case 'b':
{
- char *savepat = pat;
+ register char *str;
I32 saveitems;
fromstr = NEXTFROM;
saveitems = items;
- aptr = SvPV(fromstr, fromlen);
+ str = SvPV(fromstr, fromlen);
if (pat[-1] == '*')
len = fromlen;
- pat = aptr;
aint = SvCUR(cat);
SvCUR(cat) += (len+7)/8;
SvGROW(cat, SvCUR(cat) + 1);
items = 0;
if (datumtype == 'B') {
for (len = 0; len++ < aint;) {
- items |= *pat++ & 1;
+ items |= *str++ & 1;
if (len & 7)
items <<= 1;
else {
}
else {
for (len = 0; len++ < aint;) {
- if (*pat++ & 1)
+ if (*str++ & 1)
items |= 128;
if (len & 7)
items >>= 1;
items >>= 7 - (aint & 7);
*aptr++ = items & 0xff;
}
- pat = SvPVX(cat) + SvCUR(cat);
- while (aptr <= pat)
+ str = SvPVX(cat) + SvCUR(cat);
+ while (aptr <= str)
*aptr++ = '\0';
- pat = savepat;
items = saveitems;
}
break;
case 'H':
case 'h':
{
- char *savepat = pat;
+ register char *str;
I32 saveitems;
fromstr = NEXTFROM;
saveitems = items;
- aptr = SvPV(fromstr, fromlen);
+ str = SvPV(fromstr, fromlen);
if (pat[-1] == '*')
len = fromlen;
- pat = aptr;
aint = SvCUR(cat);
SvCUR(cat) += (len+1)/2;
SvGROW(cat, SvCUR(cat) + 1);
items = 0;
if (datumtype == 'H') {
for (len = 0; len++ < aint;) {
- if (isALPHA(*pat))
- items |= ((*pat++ & 15) + 9) & 15;
+ if (isALPHA(*str))
+ items |= ((*str++ & 15) + 9) & 15;
else
- items |= *pat++ & 15;
+ items |= *str++ & 15;
if (len & 1)
items <<= 4;
else {
}
else {
for (len = 0; len++ < aint;) {
- if (isALPHA(*pat))
- items |= (((*pat++ & 15) + 9) & 15) << 4;
+ if (isALPHA(*str))
+ items |= (((*str++ & 15) + 9) & 15) << 4;
else
- items |= (*pat++ & 15) << 4;
+ items |= (*str++ & 15) << 4;
if (len & 1)
items >>= 4;
else {
}
if (aint & 1)
*aptr++ = items & 0xff;
- pat = SvPVX(cat) + SvCUR(cat);
- while (aptr <= pat)
+ str = SvPVX(cat) + SvCUR(cat);
+ while (aptr <= str)
*aptr++ = '\0';
- pat = savepat;
items = saveitems;
}
break;
sv_catpvn(cat, (char*)&aquad, sizeof(Quad_t));
}
break;
-#endif /* Quad_t */
+#endif
case 'P':
len = 1; /* assume SV is correct length */
/* FALL THROUGH */
* of pack() (and all copies of the result) are
* gone.
*/
- if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
+ if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr)
+ || (SvPADTMP(fromstr)
+ && !SvREADONLY(fromstr))))
+ {
Perl_warner(aTHX_ WARN_UNSAFE,
"Attempt to pack pointer to temporary value");
+ }
if (SvPOK(fromstr) || SvNIOK(fromstr))
aptr = SvPV(fromstr,n_a);
else
projects / p5sagit/p5-mst-13.2.git / blobdiff