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;
}
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);
(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);
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++;
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) {