else {
if (SvTYPE(sv) != SVt_PVGV) {
char *sym;
- STRLEN n_a;
+ STRLEN len;
if (SvGMAGICAL(sv)) {
mg_get(sv);
if (SvROK(sv))
goto wasref;
}
- if (!SvOK(sv)) {
+ if (!SvOK(sv) && sv != &PL_sv_undef) {
/* If this is a 'my' scalar and flag is set then vivify
* NI-S 1999/05/07
*/
report_uninit();
RETSETUNDEF;
}
- sym = SvPV(sv, n_a);
+ sym = SvPV(sv,len);
if ((PL_op->op_flags & OPf_SPECIAL) &&
!(PL_op->op_flags & OPf_MOD))
{
sv = (SV*)gv_fetchpv(sym, FALSE, SVt_PVGV);
- if (!sv)
+ if (!sv
+ && (!is_gv_magical(sym,len,0)
+ || !(sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV))))
+ {
RETSETUNDEF;
+ }
}
else {
if (PL_op->op_private & HINT_STRICT_REFS)
else {
GV *gv = (GV*)sv;
char *sym;
- STRLEN n_a;
+ STRLEN len;
if (SvTYPE(gv) != SVt_PVGV) {
if (SvGMAGICAL(sv)) {
report_uninit();
RETSETUNDEF;
}
- sym = SvPV(sv, n_a);
+ sym = SvPV(sv, len);
if ((PL_op->op_flags & OPf_SPECIAL) &&
!(PL_op->op_flags & OPf_MOD))
{
gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PV);
- if (!gv)
+ if (!gv
+ && (!is_gv_magical(sym,len,0)
+ || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV))))
+ {
RETSETUNDEF;
+ }
}
else {
if (PL_op->op_private & HINT_STRICT_REFS)
seen_question = 1;
str[n++] = ';';
}
- else if (seen_question)
+ else if (n && str[0] == ';' && seen_question)
goto set; /* XXXX system, exec */
if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF
&& (oa & (OA_OPTIONAL - 1)) <= OA_HVREF) {
else {
SV *ssv = POPs;
STRLEN len;
- char *ptr = SvPV(ssv,len);
+ char *ptr;
+
+ if (ssv && !SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv))
+ Perl_croak(aTHX_ "Attempt to bless into a reference");
+ ptr = SvPV(ssv,len);
if (ckWARN(WARN_MISC) && len == 0)
Perl_warner(aTHX_ WARN_MISC,
"Explicit blessing to '' (assuming package main)");
case 'F':
if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */
tmpRef = (SV*)GvIOp(gv);
+ else
+ if (strEQ(elem, "FORMAT"))
+ tmpRef = (SV*)GvFORM(gv);
break;
case 'G':
if (strEQ(elem, "GLOB"))
NV dright;
NV dleft;
- if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
+ if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
IV i = SvIVX(POPs);
right = (right_neg = (i < 0)) ? -i : i;
}
dright = -dright;
}
- if (!use_double && SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
+ if (!use_double && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
IV i = SvIVX(POPs);
left = (left_neg = (i < 0)) ? -i : i;
}
SP -= items;
}
else { /* Note: mark already snarfed by pp_list */
- SV *tmpstr;
+ SV *tmpstr = POPs;
STRLEN len;
+ bool isutf = DO_UTF8(tmpstr);
- tmpstr = POPs;
SvSetSV(TARG, tmpstr);
SvPV_force(TARG, len);
if (count != 1) {
}
*SvEND(TARG) = '\0';
}
- (void)SvPOK_only(TARG);
+ if (isutf)
+ (void)SvPOK_only_UTF8(TARG);
+ else
+ (void)SvPOK_only(TARG);
PUSHTARG;
}
RETURN;
dPOPTOPnnrl;
I32 value;
+#ifdef Perl_isnan
+ if (Perl_isnan(left) || Perl_isnan(right)) {
+ SETs(&PL_sv_undef);
+ RETURN;
+ }
+ value = (left > right) - (left < right);
+#else
if (left == right)
value = 0;
else if (left < right)
SETs(&PL_sv_undef);
RETURN;
}
+#endif
SETi(value);
RETURN;
}
dTOPss;
if (SvGMAGICAL(sv))
mg_get(sv);
- if (SvIOKp(sv) && !SvNOKp(sv) && !SvPOKp(sv) && SvIVX(sv) != IV_MIN)
- SETi(-SvIVX(sv));
- else if (SvNIOKp(sv))
+ if (SvIOKp(sv) && !SvNOKp(sv) && !SvPOKp(sv)) {
+ if (SvIsUV(sv)) {
+ if (SvIVX(sv) == IV_MIN) {
+ SETi(SvIVX(sv)); /* special case: -((UV)IV_MAX+1) == IV_MIN */
+ RETURN;
+ }
+ else if (SvUVX(sv) <= IV_MAX) {
+ SETi(-SvIVX(sv));
+ RETURN;
+ }
+ }
+ else if (SvIVX(sv) != IV_MIN) {
+ SETi(-SvIVX(sv));
+ RETURN;
+ }
+ }
+ if (SvNIOKp(sv))
SETn(-SvNV(sv));
else if (SvPOKp(sv)) {
STRLEN len;
NV value;
value = POPn;
if (value <= 0.0) {
- RESTORE_NUMERIC_STANDARD();
+ SET_NUMERIC_STANDARD();
DIE(aTHX_ "Can't take log of %g", value);
}
value = Perl_log(value);
NV value;
value = POPn;
if (value < 0.0) {
- RESTORE_NUMERIC_STANDARD();
+ SET_NUMERIC_STANDARD();
DIE(aTHX_ "Can't take sqrt of %g", value);
}
value = Perl_sqrt(value);
STRLEN n_a;
tmps = POPpx;
+ argtype = 1; /* allow underscores */
XPUSHn(scan_hex(tmps, 99, &argtype));
RETURN;
}
tmps++;
if (*tmps == '0')
tmps++;
+ argtype = 1; /* allow underscores */
if (*tmps == 'x')
value = scan_hex(++tmps, 99, &argtype);
else if (*tmps == 'b')
RETPUSHUNDEF;
}
else {
- if (utfcurlen) {
+ if (utfcurlen)
sv_pos_u2b(sv, &pos, &rem);
- SvUTF8_on(TARG);
- }
tmps += pos;
sv_setpvn(TARG, tmps, rem);
+ if (utfcurlen)
+ SvUTF8_on(TARG);
if (repl)
sv_insert(sv, pos, rem, repl, repl_len);
else if (lvalue) { /* it's an lvalue! */
"Attempt to use reference as lvalue in substr");
}
if (SvOK(sv)) /* is it defined ? */
- (void)SvPOK_only(sv);
+ (void)SvPOK_only_UTF8(sv);
else
sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
}
I32 retlen;
if ((*tmps & 0x80) && DO_UTF8(tmpsv))
- value = utf8_to_uv(tmps, &retlen);
+ value = utf8_to_uv_chk(tmps, &retlen, 0);
else
value = (UV)(*tmps & 255);
XPUSHu(value);
(void)SvUPGRADE(TARG,SVt_PV);
- if (value > 255 && !IN_BYTE) {
+ if ((value > 255 && !IN_BYTE) || (value & 0x80 && PL_hints & HINT_UTF8) ) {
SvGROW(TARG, UTF8_MAXLEN+1);
tmps = SvPVX(TARG);
tmps = (char*)uv_to_utf8((U8*)tmps, (UV)value);
tmps = SvPVX(TARG);
*tmps++ = value;
*tmps = '\0';
- SvUTF8_off(TARG); /* decontaminate */
(void)SvPOK_only(TARG);
XPUSHs(TARG);
RETURN;
I32 ulen;
U8 tmpbuf[UTF8_MAXLEN];
U8 *tend;
- UV uv = utf8_to_uv(s, &ulen);
+ UV uv = utf8_to_uv_chk(s, &ulen, 0);
if (PL_op->op_private & OPpLOCALE) {
TAINT;
I32 ulen;
U8 tmpbuf[UTF8_MAXLEN];
U8 *tend;
- UV uv = utf8_to_uv(s, &ulen);
+ UV uv = utf8_to_uv_chk(s, &ulen, 0);
if (PL_op->op_private & OPpLOCALE) {
TAINT;
TAINT;
SvTAINTED_on(TARG);
while (s < send) {
- d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv(s, &ulen)));
+ d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv_chk(s, &ulen, 0)));
s += ulen;
}
}
TAINT;
SvTAINTED_on(TARG);
while (s < send) {
- d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv(s, &ulen)));
+ d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv_chk(s, &ulen, 0)));
s += ulen;
}
}
}
*d = '\0';
SvCUR_set(TARG, d - SvPVX(TARG));
- (void)SvPOK_only(TARG);
+ (void)SvPOK_only_UTF8(TARG);
}
else
sv_setpvn(TARG, s, len);
SV **tmparyval = 0;
MAGIC *mg;
- if (mg = SvTIED_mg((SV*)ary, 'P')) {
+ if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
*MARK-- = SvTIED_obj((SV*)ary, mg);
PUSHMARK(MARK);
PUTBACK;
register SV *sv = &PL_sv_undef;
MAGIC *mg;
- if (mg = SvTIED_mg((SV*)ary, 'P')) {
+ if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
*MARK-- = SvTIED_obj((SV*)ary, mg);
PUSHMARK(MARK);
PUTBACK;
register I32 i = 0;
MAGIC *mg;
- if (mg = SvTIED_mg((SV*)ary, 'P')) {
+ if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
*MARK-- = SvTIED_obj((SV*)ary, mg);
PUSHMARK(MARK);
PUTBACK;
*up++ = *down;
*down-- = tmp;
}
- (void)SvPOK_only(TARG);
+ (void)SvPOK_only_UTF8(TARG);
}
SP = MARK + 1;
SETTARG;
len = strend - s;
if (checksum) {
while (len-- > 0 && s < strend) {
- auint = utf8_to_uv((U8*)s, &along);
+ auint = utf8_to_uv_chk((U8*)s, &along, 0);
s += along;
if (checksum > 32)
cdouble += (NV)auint;
EXTEND(SP, len);
EXTEND_MORTAL(len);
while (len-- > 0 && s < strend) {
- auint = utf8_to_uv((U8*)s, &along);
+ auint = utf8_to_uv_chk((U8*)s, &along, 0);
s += along;
sv = NEWSV(37, 0);
sv_setuv(sv, (UV)auint);
char *t;
STRLEN n_a;
- sv = Perl_newSVpvf(aTHX_ "%.*Vu", (int)TYPE_DIGITS(UV), auv);
+ sv = Perl_newSVpvf(aTHX_ "%.*"UVf, (int)TYPE_DIGITS(UV), auv);
while (s < strend) {
sv = mul128(sv, *s & 0x7f);
if (!(*s++ & 0x80)) {
int i;
for (i = 0; i < sizeof(PL_uuemap); i += 1)
- PL_uudmap[PL_uuemap[i]] = i;
+ PL_uudmap[(U8)PL_uuemap[i]] = i;
/*
* Because ' ' and '`' map to the same value,
* we need to decode them both the same.
char hunk[4];
hunk[3] = '\0';
- len = PL_uudmap[*s++] & 077;
+ len = PL_uudmap[*(U8*)s++] & 077;
while (len > 0) {
if (s < strend && ISUUCHAR(*s))
- a = PL_uudmap[*s++] & 077;
+ a = PL_uudmap[*(U8*)s++] & 077;
else
a = 0;
if (s < strend && ISUUCHAR(*s))
- b = PL_uudmap[*s++] & 077;
+ b = PL_uudmap[*(U8*)s++] & 077;
else
b = 0;
if (s < strend && ISUUCHAR(*s))
- c = PL_uudmap[*s++] & 077;
+ c = PL_uudmap[*(U8*)s++] & 077;
else
c = 0;
if (s < strend && ISUUCHAR(*s))
- d = PL_uudmap[*s++] & 077;
+ d = PL_uudmap[*(U8*)s++] & 077;
else
d = 0;
hunk[0] = (a << 2) | (b >> 4);
register I32 items;
STRLEN fromlen;
register char *pat = SvPVx(*++MARK, fromlen);
+ char *patcopy;
register char *patend = pat + fromlen;
register I32 len;
I32 datumtype;
items = SP - MARK;
MARK++;
sv_setpvn(cat, "", 0);
+ patcopy = pat;
while (pat < patend) {
SV *lengthcode = Nullsv;
#define NEXTFROM ( lengthcode ? lengthcode : items-- > 0 ? *MARK++ : &PL_sv_no)
#ifdef PERL_NATINT_PACK
natint = 0;
#endif
- if (isSPACE(datumtype))
+ if (isSPACE(datumtype)) {
+ patcopy++;
continue;
+ }
+ if (datumtype == 'U' && pat == patcopy+1)
+ SvUTF8_on(cat);
if (datumtype == '#') {
while (pat < patend && *pat != '\n')
pat++;
len = 1;
if (*pat == '/') {
++pat;
- if (*pat != 'a' && *pat != 'A' && *pat != 'Z' || pat[1] != '*')
+ if ((*pat != 'a' && *pat != 'A' && *pat != 'Z') || pat[1] != '*')
DIE(aTHX_ "/ must be followed by a*, A* or Z*");
lengthcode = sv_2mortal(newSViv(sv_len(items > 0
- ? *MARK : &PL_sv_no)));
+ ? *MARK : &PL_sv_no)
+ + (*pat == 'Z' ? 1 : 0)));
}
switch(datumtype) {
default:
DIE(aTHX_ "Cannot compress negative numbers");
if (
-#ifdef CXUX_BROKEN_CONSTANT_CONVERT
- adouble <= UV_MAX_cxux
+#if UVSIZE > 4 && UVSIZE >= NVSIZE
+ adouble <= 0xffffffff
#else
+# ifdef CXUX_BROKEN_CONSTANT_CONVERT
+ adouble <= UV_MAX_cxux
+# else
adouble <= UV_MAX
+# endif
#endif
)
{
AV *ary;
register I32 limit = POPi; /* note, negative is forever */
SV *sv = POPs;
+ bool isutf = DO_UTF8(sv);
STRLEN len;
register char *s = SvPV(sv, len);
char *strend = s + len;
av_extend(ary,0);
av_clear(ary);
SPAGAIN;
- if (mg = SvTIED_mg((SV*)ary, 'P')) {
+ if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)ary, mg));
}
sv_setpvn(dstr, s, m-s);
if (make_mortal)
sv_2mortal(dstr);
+ if (isutf)
+ (void)SvUTF8_on(dstr);
XPUSHs(dstr);
s = m + 1;
sv_setpvn(dstr, s, m-s);
if (make_mortal)
sv_2mortal(dstr);
+ if (isutf)
+ (void)SvUTF8_on(dstr);
XPUSHs(dstr);
s = m;
}
sv_setpvn(dstr, s, m-s);
if (make_mortal)
sv_2mortal(dstr);
+ if (isutf)
+ (void)SvUTF8_on(dstr);
XPUSHs(dstr);
s = m + 1;
}
sv_setpvn(dstr, s, m-s);
if (make_mortal)
sv_2mortal(dstr);
+ if (isutf)
+ (void)SvUTF8_on(dstr);
XPUSHs(dstr);
s = m + len; /* Fake \n at the end */
}
sv_setpvn(dstr, s, m-s);
if (make_mortal)
sv_2mortal(dstr);
+ if (isutf)
+ (void)SvUTF8_on(dstr);
XPUSHs(dstr);
if (rx->nparens) {
for (i = 1; i <= rx->nparens; i++) {
dstr = NEWSV(33, 0);
if (make_mortal)
sv_2mortal(dstr);
+ if (isutf)
+ (void)SvUTF8_on(dstr);
XPUSHs(dstr);
}
}
sv_setpvn(dstr, s, strend-s);
if (make_mortal)
sv_2mortal(dstr);
+ if (isutf)
+ (void)SvUTF8_on(dstr);
XPUSHs(dstr);
iters++;
}
dTOPss;
SV *retsv = sv;
#ifdef USE_THREADS
- MAGIC *mg;
-
- if (SvROK(sv))
- sv = SvRV(sv);
-
- mg = condpair_magic(sv);
- MUTEX_LOCK(MgMUTEXP(mg));
- if (MgOWNER(mg) == thr)
- MUTEX_UNLOCK(MgMUTEXP(mg));
- else {
- while (MgOWNER(mg))
- COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
- MgOWNER(mg) = thr;
- DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": pp_lock lock 0x%"UVxf"\n",
- PTR2UV(thr), PTR2UV(sv));)
- MUTEX_UNLOCK(MgMUTEXP(mg));
- SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
- }
+ sv_lock(sv);
#endif /* USE_THREADS */
if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
|| SvTYPE(retsv) == SVt_PVCV) {
PP(pp_threadsv)
{
- djSP;
#ifdef USE_THREADS
+ djSP;
EXTEND(SP, 1);
if (PL_op->op_private & OPpLVAL_INTRO)
PUSHs(*save_threadsv(PL_op->op_targ));
projects / p5sagit/p5-mst-13.2.git / blobdiff