SvREFCNT_inc_void_NN(sv);
sv = (SV*) gv;
}
- else if (SvTYPE(sv) != SVt_PVGV)
+ else if (!isGV_with_GP(sv))
DIE(aTHX_ "Not a GLOB reference");
}
else {
- if (SvTYPE(sv) != SVt_PVGV) {
+ if (!isGV_with_GP(sv)) {
if (SvGMAGICAL(sv)) {
mg_get(sv);
if (SvROK(sv))
/* Helper function for pp_rv2sv and pp_rv2av */
GV *
-Perl_softref2xv(pTHX_ SV *const sv, const char *const what, const U32 type,
- SV ***spp)
+Perl_softref2xv(pTHX_ SV *const sv, const char *const what,
+ const svtype type, SV ***spp)
{
dVAR;
GV *gv;
+ PERL_ARGS_ASSERT_SOFTREF2XV;
+
if (PL_op->op_private & HINT_STRICT_REFS) {
if (SvOK(sv))
Perl_die(aTHX_ PL_no_symref_sv, sv, what);
else {
gv = (GV*)sv;
- if (SvTYPE(gv) != SVt_PVGV) {
+ if (!isGV_with_GP(gv)) {
if (SvGMAGICAL(sv)) {
mg_get(sv);
if (SvROK(sv))
|| code == -KEY_exec || code == -KEY_system)
goto set;
if (code == -KEY_mkdir) {
- ret = sv_2mortal(newSVpvs("_;$"));
+ ret = newSVpvs_flags("_;$", SVs_TEMP);
goto set;
}
if (code == -KEY_readpipe) {
if (defgv && str[n - 1] == '$')
str[n - 1] = '_';
str[n++] = '\0';
- ret = sv_2mortal(newSVpvn(str, n - 1));
+ ret = newSVpvn_flags(str, n - 1, SVs_TEMP);
}
else if (code) /* Non-Overridable */
goto set;
}
cv = sv_2cv(TOPs, &stash, &gv, 0);
if (cv && SvPOK(cv))
- ret = sv_2mortal(newSVpvn(SvPVX_const(cv), SvCUR(cv)));
+ ret = newSVpvn_flags(SvPVX_const(cv), SvCUR(cv), SVs_TEMP);
set:
SETs(ret);
RETURN;
dVAR;
SV* rv;
+ PERL_ARGS_ASSERT_REFTO;
+
if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y') {
if (LvTARGLEN(sv))
vivify_defelem(sv);
break;
case 'N':
if (strEQ(second_letter, "AME"))
- sv = newSVpvn(GvNAME(gv), GvNAMELEN(gv));
+ sv = newSVhek(GvNAME_HEK(gv));
break;
case 'P':
if (strEQ(second_letter, "ACKAGE")) {
}
break;
case SVt_PVGV:
- if (SvFAKE(sv))
+ if (SvFAKE(sv)) {
SvSetMagicSV(sv, &PL_sv_undef);
- else {
+ break;
+ }
+ else if (isGV_with_GP(sv)) {
GP *gp;
HV *stash;
GvLINE(sv) = CopLINE(PL_curcop);
GvEGV(sv) = (GV*)sv;
GvMULTI_on(sv);
+ break;
}
- break;
+ /* FALL THROUGH */
default:
if (SvTYPE(sv) >= SVt_PV && SvPVX_const(sv) && SvLEN(sv)) {
SvPV_free(sv);
PP(pp_predec)
{
dVAR; dSP;
- if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
+ if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
DIE(aTHX_ PL_no_modify);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != IV_MIN)
PP(pp_postinc)
{
dVAR; dSP; dTARGET;
- if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
+ if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
DIE(aTHX_ PL_no_modify);
sv_setsv(TARG, TOPs);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
PP(pp_postdec)
{
dVAR; dSP; dTARGET;
- if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
+ if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
DIE(aTHX_ PL_no_modify);
sv_setsv(TARG, TOPs);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
/* This is the i_modulo with the workaround for the _moddi3 bug
* in (at least) glibc 2.2.5 (the PERL_ABS() the workaround).
* See below for pp_i_modulo. */
- dVAR; dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
dPOPTOPiirl;
if (!right)
dVAR; dSP; dTARGET;
SV * const sv = TOPs;
- if (SvAMAGIC(sv)) {
- /* For an overloaded scalar, we can't know in advance if it's going to
- be UTF-8 or not. Also, we can't call sv_len_utf8 as it likes to
- cache the length. Maybe that should be a documented feature of it.
+ if (SvGAMAGIC(sv)) {
+ /* For an overloaded or magic scalar, we can't know in advance if
+ it's going to be UTF-8 or not. Also, we can't call sv_len_utf8 as
+ it likes to cache the length. Maybe that should be a documented
+ feature of it.
*/
STRLEN len;
- const char *const p = SvPV_const(sv, len);
+ const char *const p
+ = sv_2pv_flags(sv, &len,
+ SV_UNDEF_RETURNS_NULL|SV_CONST_RETURN|SV_GMAGIC);
- if (DO_UTF8(sv)) {
+ if (!p)
+ SETs(&PL_sv_undef);
+ else if (DO_UTF8(sv)) {
SETi(utf8_length((U8*)p, (U8*)p + len));
}
else
SETi(len);
-
+ } else if (SvOK(sv)) {
+ /* Neither magic nor overloaded. */
+ if (DO_UTF8(sv))
+ SETi(sv_len_utf8(sv));
+ else
+ SETi(sv_len(sv));
+ } else {
+ SETs(&PL_sv_undef);
}
- else if (DO_UTF8(sv))
- SETi(sv_len_utf8(sv));
- else
- SETi(sv_len(sv));
RETURN;
}
repl = SvPV_const(repl_sv_copy, repl_len);
repl_is_utf8 = DO_UTF8(repl_sv_copy) && SvCUR(sv);
}
- sv_insert(sv, pos, rem, repl, repl_len);
+ if (!SvOK(sv))
+ sv_setpvs(sv, "");
+ sv_insert_flags(sv, pos, rem, repl, repl_len, 0);
if (repl_is_utf8)
SvUTF8_on(sv);
if (repl_sv_copy)
else if (SvOK(sv)) /* is it defined ? */
(void)SvPOK_only_UTF8(sv);
else
- sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
+ sv_setpvs(sv, ""); /* avoid lexical reincarnation */
}
if (SvTYPE(TARG) < SVt_PVLV) {
Otherwise I need to avoid calls to sv_pos_u2b(), which (dangerously)
will trigger magic and overloading again, as will fbm_instr()
*/
- big = sv_2mortal(newSVpvn(big_p, biglen));
- if (big_utf8)
- SvUTF8_on(big);
+ big = newSVpvn_flags(big_p, biglen,
+ SVs_TEMP | (big_utf8 ? SVf_UTF8 : 0));
big_p = SvPVX(big);
}
if (SvGAMAGIC(little) || (is_index && !SvOK(little))) {
This is all getting to messy. The API isn't quite clean enough,
because data access has side effects.
*/
- little = sv_2mortal(newSVpvn(little_p, llen));
- if (little_utf8)
- SvUTF8_on(little);
+ little = newSVpvn_flags(little_p, llen,
+ SVs_TEMP | (little_utf8 ? SVf_UTF8 : 0));
little_p = SvPVX(little);
}
if (SvOK(source)) {
s = (const U8*)SvPV_nomg_const(source, slen);
} else {
+ if (ckWARN(WARN_UNINITIALIZED))
+ report_uninit(source);
s = (const U8*)"";
slen = 0;
}
if (SvOK(source)) {
s = (const U8*)SvPV_nomg_const(source, len);
} else {
+ if (ckWARN(WARN_UNINITIALIZED))
+ report_uninit(source);
s = (const U8*)"";
len = 0;
}
if (SvOK(source)) {
s = (const U8*)SvPV_nomg_const(source, len);
} else {
+ if (ckWARN(WARN_UNINITIALIZED))
+ report_uninit(source);
s = (const U8*)"";
len = 0;
}
const I32 items = SP - MARK;
SV * const av = (SV *) av_make(items, MARK+1);
SP = ORIGMARK; /* av_make() might realloc stack_sp */
- XPUSHs(sv_2mortal((PL_op->op_flags & OPf_SPECIAL)
- ? newRV_noinc(av) : av));
+ mXPUSHs((PL_op->op_flags & OPf_SPECIAL)
+ ? newRV_noinc(av) : av);
RETURN;
}
(void)hv_store_ent(hv,key,val,0);
}
SP = ORIGMARK;
- XPUSHs(sv_2mortal((PL_op->op_flags & OPf_SPECIAL)
- ? newRV_noinc((SV*) hv) : (SV*)hv));
+ mXPUSHs((PL_op->op_flags & OPf_SPECIAL)
+ ? newRV_noinc((SV*) hv) : (SV*) hv);
RETURN;
}
SvUTF8_off(TARG); /* decontaminate */
if (SP - MARK > 1)
do_join(TARG, &PL_sv_no, MARK, SP);
- else
+ else {
sv_setsv(TARG, (SP > MARK)
? *SP
: (padoff_du = find_rundefsvoffset(),
(padoff_du == NOT_IN_PAD
|| PAD_COMPNAME_FLAGS_isOUR(padoff_du))
? DEFSV : PAD_SVl(padoff_du)));
+
+ if (! SvOK(TARG) && ckWARN(WARN_UNINITIALIZED))
+ report_uninit(TARG);
+ }
+
up = SvPV_force(TARG, len);
if (len > 1) {
if (DO_UTF8(TARG)) { /* first reverse each character */
I32 base;
const I32 gimme = GIMME_V;
const I32 oldsave = PL_savestack_ix;
- I32 make_mortal = 1;
+ U32 make_mortal = SVs_TEMP;
bool multiline = 0;
MAGIC *mg = NULL;
if (m >= strend)
break;
- dstr = newSVpvn(s, m-s);
- if (make_mortal)
- sv_2mortal(dstr);
- if (do_utf8)
- (void)SvUTF8_on(dstr);
+ dstr = newSVpvn_flags(s, m-s,
+ (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
XPUSHs(dstr);
/* skip the whitespace found last */
m++;
if (m >= strend)
break;
- dstr = newSVpvn(s, m-s);
- if (make_mortal)
- sv_2mortal(dstr);
- if (do_utf8)
- (void)SvUTF8_on(dstr);
+ dstr = newSVpvn_flags(s, m-s,
+ (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
XPUSHs(dstr);
s = m;
}
/* keep track of how many bytes we skip over */
m = s;
s += UTF8SKIP(s);
- dstr = newSVpvn(m, s-m);
-
- if (make_mortal)
- sv_2mortal(dstr);
+ dstr = newSVpvn_flags(m, s-m, SVf_UTF8 | make_mortal);
- (void)SvUTF8_on(dstr);
PUSHs(dstr);
if (s >= strend)
}
}
}
- else if (do_utf8 == ((RX_EXTFLAGS(rx) & RXf_UTF8) != 0) &&
+ else if (do_utf8 == (RX_UTF8(rx) != 0) &&
(RX_EXTFLAGS(rx) & RXf_USE_INTUIT) && !RX_NPARENS(rx)
&& (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
&& !(RX_EXTFLAGS(rx) & RXf_ANCH)) {
SV * const csv = CALLREG_INTUIT_STRING(rx);
len = RX_MINLENRET(rx);
- if (len == 1 && !(RX_EXTFLAGS(rx) & RXf_UTF8) && !tail) {
+ if (len == 1 && !RX_UTF8(rx) && !tail) {
const char c = *SvPV_nolen_const(csv);
while (--limit) {
for (m = s; m < strend && *m != c; m++)
;
if (m >= strend)
break;
- dstr = newSVpvn(s, m-s);
- if (make_mortal)
- sv_2mortal(dstr);
- if (do_utf8)
- (void)SvUTF8_on(dstr);
+ dstr = newSVpvn_flags(s, m-s,
+ (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
XPUSHs(dstr);
/* The rx->minlen is in characters but we want to step
* s ahead by bytes. */
(m = fbm_instr((unsigned char*)s, (unsigned char*)strend,
csv, multiline ? FBMrf_MULTILINE : 0)) )
{
- dstr = newSVpvn(s, m-s);
- if (make_mortal)
- sv_2mortal(dstr);
- if (do_utf8)
- (void)SvUTF8_on(dstr);
+ dstr = newSVpvn_flags(s, m-s,
+ (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
XPUSHs(dstr);
/* The rx->minlen is in characters but we want to step
* s ahead by bytes. */
strend = s + (strend - m);
}
m = RX_OFFS(rx)[0].start + orig;
- dstr = newSVpvn(s, m-s);
- if (make_mortal)
- sv_2mortal(dstr);
- if (do_utf8)
- (void)SvUTF8_on(dstr);
+ dstr = newSVpvn_flags(s, m-s,
+ (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
XPUSHs(dstr);
if (RX_NPARENS(rx)) {
I32 i;
parens that didn't match -- they should be set to
undef, not the empty string */
if (m >= orig && s >= orig) {
- dstr = newSVpvn(s, m-s);
+ dstr = newSVpvn_flags(s, m-s,
+ (do_utf8 ? SVf_UTF8 : 0)
+ | make_mortal);
}
else
dstr = &PL_sv_undef; /* undef, not "" */
- if (make_mortal)
- sv_2mortal(dstr);
- if (do_utf8)
- (void)SvUTF8_on(dstr);
XPUSHs(dstr);
}
}
/* keep field after final delim? */
if (s < strend || (iters && origlimit)) {
const STRLEN l = strend - s;
- dstr = newSVpvn(s, l);
- if (make_mortal)
- sv_2mortal(dstr);
- if (do_utf8)
- (void)SvUTF8_on(dstr);
+ dstr = newSVpvn_flags(s, l, (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
XPUSHs(dstr);
iters++;
}
projects / p5sagit/p5-mst-13.2.git / blobdiff