if (SvROK(sv)) {
wasref:
+ tryAMAGICunDEREF(to_gv);
+
sv = SvRV(sv);
if (SvTYPE(sv) == SVt_PVIO) {
GV *gv = (GV*) sv_newmortal();
else {
if (SvTYPE(sv) != SVt_PVGV) {
char *sym;
+ STRLEN n_a;
if (SvGMAGICAL(sv)) {
mg_get(sv);
if (!SvOK(sv)) {
if (PL_op->op_flags & OPf_REF ||
PL_op->op_private & HINT_STRICT_REFS)
- DIE(no_usym, "a symbol");
+ DIE(PL_no_usym, "a symbol");
if (ckWARN(WARN_UNINITIALIZED))
- warner(WARN_UNINITIALIZED, warn_uninit);
+ warner(WARN_UNINITIALIZED, PL_warn_uninit);
RETSETUNDEF;
}
- sym = SvPV(sv, PL_na);
+ sym = SvPV(sv, n_a);
if (PL_op->op_private & HINT_STRICT_REFS)
- DIE(no_symref, sym, "a symbol");
+ DIE(PL_no_symref, sym, "a symbol");
sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
}
}
if (SvROK(sv)) {
wasref:
+ tryAMAGICunDEREF(to_sv);
+
sv = SvRV(sv);
switch (SvTYPE(sv)) {
case SVt_PVAV:
else {
GV *gv = (GV*)sv;
char *sym;
+ STRLEN n_a;
if (SvTYPE(gv) != SVt_PVGV) {
if (SvGMAGICAL(sv)) {
if (!SvOK(sv)) {
if (PL_op->op_flags & OPf_REF ||
PL_op->op_private & HINT_STRICT_REFS)
- DIE(no_usym, "a SCALAR");
+ DIE(PL_no_usym, "a SCALAR");
if (ckWARN(WARN_UNINITIALIZED))
- warner(WARN_UNINITIALIZED, warn_uninit);
+ warner(WARN_UNINITIALIZED, PL_warn_uninit);
RETSETUNDEF;
}
- sym = SvPV(sv, PL_na);
+ sym = SvPV(sv, n_a);
if (PL_op->op_private & HINT_STRICT_REFS)
- DIE(no_symref, sym, "a SCALAR");
+ DIE(PL_no_symref, sym, "a SCALAR");
gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
}
sv = GvSV(gv);
char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */
while (i < MAXO) { /* The slow way. */
- if (strEQ(s + 6, op_name[i]) || strEQ(s + 6, op_desc[i]))
+ if (strEQ(s + 6, PL_op_name[i])
+ || strEQ(s + 6, PL_op_desc[i]))
+ {
goto found;
+ }
i++;
}
goto nonesuch; /* Should not happen... */
found:
- oa = opargs[i] >> OASHIFT;
+ oa = PL_opargs[i] >> OASHIFT;
while (oa) {
if (oa & OA_OPTIONAL) {
seen_question = 1;
SV *tmpRef;
char *elem;
djSP;
-
+ STRLEN n_a;
+
sv = POPs;
- elem = SvPV(sv, PL_na);
+ elem = SvPV(sv, n_a);
gv = (GV*)POPs;
tmpRef = Nullsv;
sv = Nullsv;
RETPUSHNO;
switch (SvTYPE(sv)) {
case SVt_PVAV:
- if (AvMAX(sv) >= 0 || SvGMAGICAL(sv))
+ if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P')))
RETPUSHYES;
break;
case SVt_PVHV:
- if (HvARRAY(sv) || SvGMAGICAL(sv))
+ if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P')))
RETPUSHYES;
break;
case SVt_PVCV:
RETPUSHUNDEF;
if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv))
- RETPUSHUNDEF;
+ if (SvREADONLY(sv)) {
+ dTHR;
+ if (PL_curcop != &PL_compiling)
+ croak(PL_no_modify);
+ }
if (SvROK(sv))
sv_unref(sv);
}
{
djSP;
if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
- croak(no_modify);
+ croak(PL_no_modify);
if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
SvIVX(TOPs) != IV_MIN)
{
{
djSP; dTARGET;
if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
- croak(no_modify);
+ croak(PL_no_modify);
sv_setsv(TARG, TOPs);
if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
SvIVX(TOPs) != IV_MAX)
{
djSP; dTARGET;
if(SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
- croak(no_modify);
+ croak(PL_no_modify);
sv_setsv(TARG, TOPs);
if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
SvIVX(TOPs) != IV_MIN)
sv_setsv(TARG, sv);
*SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
}
- else if (IN_UTF8 && *(U8*)s >= 0xc0 && isIDFIRST_utf8(s)) {
+ else if (IN_UTF8 && *(U8*)s >= 0xc0 && isIDFIRST_utf8((U8*)s)) {
sv_setpvn(TARG, "-", 1);
sv_catsv(TARG, sv);
}
djSP; dTARGET;
char *tmps;
I32 argtype;
+ STRLEN n_a;
- tmps = POPp;
+ tmps = POPpx;
XPUSHu(scan_hex(tmps, 99, &argtype));
RETURN;
}
UV value;
I32 argtype;
char *tmps;
+ STRLEN n_a;
- tmps = POPp;
+ tmps = POPpx;
while (*tmps && isSPACE(*tmps))
tmps++;
if (*tmps == '0')
tmps++;
if (*tmps == 'x')
value = scan_hex(++tmps, 99, &argtype);
+ else if (*tmps == 'b')
+ value = scan_bin(++tmps, 99, &argtype);
else
value = scan_oct(tmps, 99, &argtype);
XPUSHu(value);
if (lvalue) { /* it's an lvalue! */
if (!SvGMAGICAL(sv)) {
if (SvROK(sv)) {
- SvPV_force(sv,PL_na);
+ STRLEN n_a;
+ SvPV_force(sv,n_a);
if (ckWARN(WARN_SUBSTR))
warner(WARN_SUBSTR,
"Attempt to use reference as lvalue in substr");
PP(pp_ord)
{
djSP; dTARGET;
- I32 value;
- U8 *tmps = (U8*)POPp;
+ UV value;
+ STRLEN n_a;
+ U8 *tmps = (U8*)POPpx;
I32 retlen;
if (IN_UTF8 && (*tmps & 0x80))
- value = (I32) utf8_to_uv(tmps, &retlen);
+ value = utf8_to_uv(tmps, &retlen);
else
- value = (I32) (*tmps & 255);
- XPUSHi(value);
+ value = (UV)(*tmps & 255);
+ XPUSHu(value);
RETURN;
}
{
djSP; dTARGET;
char *tmps;
- I32 value = POPi;
+ U32 value = POPu;
(void)SvUPGRADE(TARG,SVt_PV);
PP(pp_crypt)
{
djSP; dTARGET; dPOPTOPssrl;
+ STRLEN n_a;
#ifdef HAS_CRYPT
- char *tmps = SvPV(left, PL_na);
+ char *tmps = SvPV(left, n_a);
#ifdef FCRYPT
- sv_setpv(TARG, fcrypt(tmps, SvPV(right, PL_na)));
+ sv_setpv(TARG, fcrypt(tmps, SvPV(right, n_a)));
#else
- sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, PL_na)));
+ sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
#endif
#else
DIE(
sv = TARG;
SETs(sv);
}
- s = (U8*)SvPV_force(sv, PL_na);
+ s = (U8*)SvPV_force(sv, slen);
if (*s) {
if (PL_op->op_private & OPpLOCALE) {
TAINT;
sv = TARG;
SETs(sv);
}
- s = (U8*)SvPV_force(sv, PL_na);
+ s = (U8*)SvPV_force(sv, slen);
if (*s) {
if (PL_op->op_private & OPpLOCALE) {
TAINT;
(void)SvUPGRADE(TARG, SVt_PV);
SvGROW(TARG, (len * 2) + 1);
d = SvPVX(TARG);
- while (len--) {
- if (!(*s & 0x80) && !isALNUM(*s))
- *d++ = '\\';
- *d++ = *s++;
+ if (IN_UTF8) {
+ while (len) {
+ if (*s & 0x80) {
+ STRLEN ulen = UTF8SKIP(s);
+ if (ulen > len)
+ ulen = len;
+ len -= ulen;
+ while (ulen--)
+ *d++ = *s++;
+ }
+ else {
+ if (!isALNUM(*s))
+ *d++ = '\\';
+ *d++ = *s++;
+ len--;
+ }
+ }
+ }
+ else {
+ while (len--) {
+ if (!isALNUM(*s))
+ *d++ = '\\';
+ *d++ = *s++;
+ }
}
*d = '\0';
SvCUR_set(TARG, d - SvPVX(TARG));
svp = av_fetch(av, elem, lval);
if (lval) {
if (!svp || *svp == &PL_sv_undef)
- DIE(no_aelem, elem);
+ DIE(PL_no_aelem, elem);
if (PL_op->op_private & OPpLVAL_INTRO)
save_aelem(av, elem, svp);
}
svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
}
if (lval) {
- if (!svp || *svp == &PL_sv_undef)
- DIE(no_helem, SvPV(keysv, PL_na));
+ if (!svp || *svp == &PL_sv_undef) {
+ STRLEN n_a;
+ DIE(PL_no_helem, SvPV(keysv, n_a));
+ }
if (PL_op->op_private & OPpLVAL_INTRO)
save_helem(hv, keysv, svp);
}
SV **tmparyval = 0;
MAGIC *mg;
- if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
- *MARK-- = mg->mg_obj;
+ if (mg = SvTIED_mg((SV*)ary, 'P')) {
+ *MARK-- = SvTIED_obj((SV*)ary, mg);
PUSHMARK(MARK);
PUTBACK;
ENTER;
else
offset -= PL_curcop->cop_arybase;
if (offset < 0)
- DIE(no_aelem, i);
+ DIE(PL_no_aelem, i);
if (++MARK < SP) {
length = SvIVx(*MARK++);
if (length < 0) {
newlen = SP - MARK;
diff = newlen - length;
- if (newlen && !AvREAL(ary)) {
- if (AvREIFY(ary))
- av_reify(ary);
- else
- assert(AvREAL(ary)); /* would leak, so croak */
- }
+ if (newlen && !AvREAL(ary) && AvREIFY(ary))
+ av_reify(ary);
if (diff < 0) { /* shrinking the area */
if (newlen) {
register SV *sv = &PL_sv_undef;
MAGIC *mg;
- if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
- *MARK-- = mg->mg_obj;
+ if (mg = SvTIED_mg((SV*)ary, 'P')) {
+ *MARK-- = SvTIED_obj((SV*)ary, mg);
PUSHMARK(MARK);
PUTBACK;
ENTER;
register I32 i = 0;
MAGIC *mg;
- if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
- *MARK-- = mg->mg_obj;
+ if (mg = SvTIED_mg((SV*)ary, 'P')) {
+ *MARK-- = SvTIED_obj((SV*)ary, mg);
PUSHMARK(MARK);
PUTBACK;
ENTER;
unsigned int auint;
U32 aulong;
#ifdef HAS_QUAD
- unsigned Quad_t auquad;
+ Uquad_t auquad;
#endif
char *aptr;
float afloat;
auint = utf8_to_uv((U8*)s, &along);
s += along;
sv = NEWSV(37, 0);
- sv_setiv(sv, (IV)auint);
+ sv_setuv(sv, (UV)auint);
PUSHs(sv_2mortal(sv));
}
}
}
else if (++bytes >= sizeof(UV)) { /* promote to string */
char *t;
+ STRLEN n_a;
sv = newSVpvf("%.*Vu", (int)TYPE_DIGITS(UV), auv);
while (s < strend) {
break;
}
}
- t = SvPV(sv, PL_na);
+ t = SvPV(sv, n_a);
while (*t == '0')
t++;
sv_chop(sv, t);
EXTEND(SP, len);
EXTEND_MORTAL(len);
while (len-- > 0) {
- if (s + sizeof(unsigned Quad_t) > strend)
+ if (s + sizeof(Uquad_t) > strend)
auquad = 0;
else {
- Copy(s, &auquad, 1, unsigned Quad_t);
- s += sizeof(unsigned Quad_t);
+ Copy(s, &auquad, 1, Uquad_t);
+ s += sizeof(Uquad_t);
}
sv = NEWSV(43, 0);
if (auquad <= UV_MAX)
STATIC SV *
is_an_int(char *s, STRLEN l)
{
+ STRLEN n_a;
SV *result = newSVpv("", l);
- char *result_c = SvPV(result, PL_na); /* convenience */
+ char *result_c = SvPV(result, n_a); /* convenience */
char *out = result_c;
bool skip = 1;
bool ignore = 0;
U32 aulong;
#ifdef HAS_QUAD
Quad_t aquad;
- unsigned Quad_t auquad;
+ Uquad_t auquad;
#endif
char *aptr;
float afloat;
case 'Q':
while (len-- > 0) {
fromstr = NEXTFROM;
- auquad = (unsigned Quad_t)SvIV(fromstr);
- sv_catpvn(cat, (char*)&auquad, sizeof(unsigned Quad_t));
+ auquad = (Uquad_t)SvIV(fromstr);
+ sv_catpvn(cat, (char*)&auquad, sizeof(Uquad_t));
}
break;
case 'q':
if (fromstr == &PL_sv_undef)
aptr = NULL;
else {
+ STRLEN n_a;
/* XXX better yet, could spirit away the string to
* a safe spot and hang on to it until the result
* of pack() (and all copies of the result) are
warner(WARN_UNSAFE,
"Attempt to pack pointer to temporary value");
if (SvPOK(fromstr) || SvNIOK(fromstr))
- aptr = SvPV(fromstr,PL_na);
+ aptr = SvPV(fromstr,n_a);
else
- aptr = SvPV_force(fromstr,PL_na);
+ aptr = SvPV_force(fromstr,n_a);
}
sv_catpvn(cat, (char*)&aptr, sizeof(char*));
}
av_extend(ary,0);
av_clear(ary);
SPAGAIN;
- if (SvRMAGICAL(ary) && (mg = mg_find((SV *) ary, 'P'))) {
+ if (mg = SvTIED_mg((SV*)ary, 'P')) {
PUSHMARK(SP);
- XPUSHs(mg->mg_obj);
+ XPUSHs(SvTIED_obj((SV*)ary, mg));
}
else {
if (!AvREAL(ary)) {
else {
maxiters += (strend - s) * rx->nparens;
while (s < strend && --limit &&
- CALLREGEXEC(rx, s, strend, orig, 1, Nullsv, NULL, 0))
+ CALLREGEXEC(rx, s, strend, orig, 1, sv, NULL, 0))
{
TAINT_IF(RX_MATCH_TAINTED(rx));
if (rx->subbase
DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n",
(unsigned long)thr, (unsigned long)sv);)
MUTEX_UNLOCK(MgMUTEXP(mg));
- SvREFCNT_inc(sv); /* keep alive until magic_mutexfree */
save_destructor(unlock_condpair, sv);
}
#endif /* USE_THREADS */
projects / p5sagit/p5-mst-13.2.git / blobdiff