SvSTASH_set(io, MUTABLE_HV(SvREFCNT_inc(GvHV(iogv))));
IoPAGE_LEN(sv) = 60;
}
- if (UNLIKELY(new_type == SVt_REGEXP))
- sv->sv_u.svu_rx = (regexp *)new_body;
- else if (old_type < SVt_PV) {
+ if (old_type < SVt_PV) {
/* referent will be NULL unless the old type was SVt_IV emulating
SVt_RV */
sv->sv_u.svu_rv = referent;
case SVt_PVGV:
if (!isGV_with_GP(sv))
break;
+ /* FALLTHROUGH */
case SVt_PVAV:
case SVt_PVHV:
case SVt_PVCV:
case SVt_PVGV:
if (!isGV_with_GP(sv))
break;
+ /* FALLTHROUGH */
case SVt_PVAV:
case SVt_PVHV:
case SVt_PVCV:
Regexps have no SvIVX and SvNVX fields.
*/
- assert(isREGEXP(sv) || SvPOKp(sv));
+ assert(SvPOKp(sv));
{
UV value;
const char * const ptr =
/* FBMs use the space for SvIVX and SvNVX for other purposes, and use
the same flag bit as SVf_IVisUV, so must not let them cache IVs.
Regexps have no SvIVX and SvNVX fields. */
- assert(isREGEXP(sv) || SvPOKp(sv));
+ assert(SvPOKp(sv));
{
UV value;
const char * const ptr =
return SvNVX(sv);
if (SvPOKp(sv) && !SvIOKp(sv)) {
ptr = SvPVX_const(sv);
- grokpv:
if (!SvIOKp(sv) && ckWARN(WARN_NUMERIC) &&
!grok_number(ptr, SvCUR(sv), NULL))
not_a_number(sv);
if (SvROK(sv)) {
goto return_rok;
}
- if (isREGEXP(sv)) {
- ptr = RX_WRAPPED((REGEXP *)sv);
- goto grokpv;
- }
assert(SvTYPE(sv) >= SVt_PVMG);
/* This falls through to the report_uninit near the end of the
function. */
/* The logic to use SVt_PVNV if necessary is in sv_upgrade. */
sv_upgrade(sv, SVt_NV);
DEBUG_c({
- STORE_NUMERIC_LOCAL_SET_STANDARD();
+ STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD();
PerlIO_printf(Perl_debug_log,
"0x%" UVxf " num(%" NVgf ")\n",
PTR2UV(sv), SvNVX(sv));
- RESTORE_NUMERIC_LOCAL();
+ RESTORE_LC_NUMERIC_UNDERLYING();
});
}
else if (SvTYPE(sv) < SVt_PVNV)
return 0.0;
}
DEBUG_c({
- STORE_NUMERIC_LOCAL_SET_STANDARD();
+ STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD();
PerlIO_printf(Perl_debug_log, "0x%" UVxf " 2nv(%" NVgf ")\n",
PTR2UV(sv), SvNVX(sv));
- RESTORE_NUMERIC_LOCAL();
+ RESTORE_LC_NUMERIC_UNDERLYING();
});
return SvNVX(sv);
}
*lp = SvCUR(buffer);
return SvPVX(buffer);
}
- else if (isREGEXP(sv)) {
- if (lp) *lp = RX_WRAPLEN((REGEXP *)sv);
- return RX_WRAPPED((REGEXP *)sv);
- }
else {
if (lp)
*lp = 0;
return cBOOL(svb);
}
}
- return SvRV(sv) != 0;
+ assert(SvRV(sv));
+ return TRUE;
}
if (isREGEXP(sv))
return
RX_WRAPLEN(sv) > 1 || (RX_WRAPLEN(sv) && *RX_WRAPPED(sv) != '0');
+
+ if (SvNOK(sv) && !SvPOK(sv))
+ return SvNVX(sv) != 0.0;
+
return SvTRUE_common(sv, isGV_with_GP(sv) ? 1 : 0);
}
}
}
- if (SvUTF8(sv)) {
+ /* SVt_REGEXP's shouldn't be upgraded to UTF8 - they're already
+ * compiled and individual nodes will remain non-utf8 even if the
+ * stringified version of the pattern gets upgraded. Whether the
+ * PVX of a REGEXP should be grown or we should just croak, I don't
+ * know - DAPM */
+ if (SvUTF8(sv) || isREGEXP(sv)) {
if (extra) SvGROW(sv, SvCUR(sv) + extra);
return SvCUR(sv);
}
U8 * s = (U8 *) SvPVX_const(sv);
U8 * e = (U8 *) SvEND(sv);
U8 *t = s;
- STRLEN two_byte_count = 0;
+ STRLEN two_byte_count;
- if (flags & SV_FORCE_UTF8_UPGRADE) goto must_be_utf8;
-
- /* See if really will need to convert to utf8. We mustn't rely on our
- * incoming SV being well formed and having a trailing '\0', as certain
- * code in pp_formline can send us partially built SVs. */
-
- while (t < e) {
- const U8 ch = *t++;
- if (NATIVE_BYTE_IS_INVARIANT(ch)) continue;
-
- t--; /* t already incremented; re-point to first variant */
- two_byte_count = 1;
- goto must_be_utf8;
- }
+ if (flags & SV_FORCE_UTF8_UPGRADE) {
+ two_byte_count = 0;
+ }
+ else {
+ if (is_utf8_invariant_string_loc(s, SvCUR(sv), (const U8 **) &t)) {
- /* utf8 conversion not needed because all are invariants. Mark as
- * UTF-8 even if no variant - saves scanning loop */
- SvUTF8_on(sv);
- if (extra) SvGROW(sv, SvCUR(sv) + extra);
- return SvCUR(sv);
+ /* utf8 conversion not needed because all are invariants. Mark
+ * as UTF-8 even if no variant - saves scanning loop */
+ SvUTF8_on(sv);
+ if (extra) SvGROW(sv, SvCUR(sv) + extra);
+ return SvCUR(sv);
+ }
- must_be_utf8:
+ /* Here, there is at least one variant, and t points to the first
+ * one */
+ two_byte_count = 1;
+ }
- /* Here, the string should be converted to utf8, either because of an
- * input flag (two_byte_count = 0), or because a character that
- * requires 2 bytes was found (two_byte_count = 1). t points either to
- * the beginning of the string (if we didn't examine anything), or to
- * the first variant. In either case, everything from s to t - 1 will
- * occupy only 1 byte each on output.
+ /* Note that the incoming SV may not have a trailing '\0', as certain
+ * code in pp_formline can send us partially built SVs.
+ *
+ * Here, the string should be converted to utf8, either because of an
+ * input flag (which causes two_byte_count to be set to 0), or because
+ * a character that requires 2 bytes was found (two_byte_count = 1). t
+ * points either to the beginning of the string (if we didn't examine
+ * anything), or to the first variant. In either case, everything from
+ * s to t - 1 will occupy only 1 byte each on output.
*
* There are two main ways to convert. One is to create a new string
* and go through the input starting from the beginning, appending each
* from s to t - 1 is invariant, the destination can be initialized
* with these using a fast memory copy
*
- * The other way is to figure out exactly how big the string should be
+ * The other way is to figure out exactly how big the string should be,
* by parsing the entire input. Then you don't have to make it big
* enough to handle the worst possible case, and more importantly, if
* the string you already have is large enough, you don't have to
* value. We go backwards through the string, converting until we
* get to the position we are at now, and then stop. If this
* position is far enough along in the string, this method is
- * faster than the other method. If the memory copy were the same
- * speed as the byte-by-byte loop, that position would be about
- * half-way, as at the half-way mark, parsing to the end and back
- * is one complete string's parse, the same amount as starting
- * over and going all the way through. Actually, it would be
- * somewhat less than half-way, as it's faster to just count bytes
- * than to also copy, and we don't have the overhead of allocating
- * a new string, changing the scalar to use it, and freeing the
- * existing one. But if the memory copy is fast, the break-even
- * point is somewhere after half way. The counting loop could be
- * sped up by vectorization, etc, to move the break-even point
- * further towards the beginning.
+ * faster than the first method above. If the memory copy were
+ * the same speed as the byte-by-byte loop, that position would be
+ * about half-way, as at the half-way mark, parsing to the end and
+ * back is one complete string's parse, the same amount as
+ * starting over and going all the way through. Actually, it
+ * would be somewhat less than half-way, as it's faster to just
+ * count bytes than to also copy, and we don't have the overhead
+ * of allocating a new string, changing the scalar to use it, and
+ * freeing the existing one. But if the memory copy is fast, the
+ * break-even point is somewhere after half way. The counting
+ * loop could be sped up by vectorization, etc, to move the
+ * break-even point further towards the beginning.
* 2) if the string doesn't have enough space to handle the converted
* value. A new string will have to be allocated, and one might
* as well, given that, start from the beginning doing the first
case SVt_REGEXP:
upgregexp:
if (dtype < SVt_REGEXP)
- {
- if (dtype >= SVt_PV) {
- SvPV_free(dstr);
- SvPV_set(dstr, 0);
- SvLEN_set(dstr, 0);
- SvCUR_set(dstr, 0);
- }
sv_upgrade(dstr, SVt_REGEXP);
- }
break;
case SVt_INVLIST:
const svtype new_type =
islv ? SVt_NULL : SvMAGIC(sv) || SvSTASH(sv) ? SVt_PVMG : SVt_PV;
SV *const temp = newSV_type(new_type);
- regexp *const temp_p = ReANY((REGEXP *)sv);
+ regexp *old_rx_body;
if (new_type == SVt_PVMG) {
SvMAGIC_set(temp, SvMAGIC(sv));
SvSTASH_set(temp, SvSTASH(sv));
SvSTASH_set(sv, NULL);
}
- if (!islv) SvCUR_set(temp, SvCUR(sv));
- /* Remember that SvPVX is in the head, not the body. But
- RX_WRAPPED is in the body. */
+ if (!islv)
+ SvCUR_set(temp, SvCUR(sv));
+ /* Remember that SvPVX is in the head, not the body. */
assert(ReANY((REGEXP *)sv)->mother_re);
+
+ if (islv) {
+ /* LV-as-regex has sv->sv_any pointing to an XPVLV body,
+ * whose xpvlenu_rx field points to the regex body */
+ XPV *xpv = (XPV*)(SvANY(sv));
+ old_rx_body = xpv->xpv_len_u.xpvlenu_rx;
+ xpv->xpv_len_u.xpvlenu_rx = NULL;
+ }
+ else
+ old_rx_body = ReANY((REGEXP *)sv);
+
/* Their buffer is already owned by someone else. */
if (flags & SV_COW_DROP_PV) {
/* SvLEN is already 0. For SVt_REGEXP, we have a brand new
- zeroed body. For SVt_PVLV, it should have been set to 0
- before turning into a regexp. */
+ zeroed body. For SVt_PVLV, we zeroed it above (len field
+ a union with xpvlenu_rx) */
assert(!SvLEN(islv ? sv : temp));
sv->sv_u.svu_pv = 0;
}
SvFLAGS(temp) &= ~(SVTYPEMASK);
SvFLAGS(temp) |= SVt_REGEXP|SVf_FAKE;
- SvANY(temp) = temp_p;
- temp->sv_u.svu_rx = (regexp *)temp_p;
+ SvANY(temp) = old_rx_body;
SvREFCNT_dec_NN(temp);
}
referred-to SV C<PERL_MAGIC_backref> magic if it hasn't already; and
push a back-reference to this RV onto the array of backreferences
associated with that magic. If the RV is magical, set magic will be
-called after the RV is cleared.
+called after the RV is cleared. Silently ignores C<undef> and warns
+on already-weak references.
=cut
*/
}
/*
+=for apidoc sv_rvunweaken
+
+Unweaken a reference: Clear the C<SvWEAKREF> flag on this RV; remove
+the backreference to this RV from the array of backreferences
+associated with the target SV, increment the refcount of the target.
+Silently ignores C<undef> and warns on non-weak references.
+
+=cut
+*/
+
+SV *
+Perl_sv_rvunweaken(pTHX_ SV *const sv)
+{
+ SV *tsv;
+
+ PERL_ARGS_ASSERT_SV_RVUNWEAKEN;
+
+ if (!SvOK(sv)) /* let undefs pass */
+ return sv;
+ if (!SvROK(sv))
+ Perl_croak(aTHX_ "Can't unweaken a nonreference");
+ else if (!SvWEAKREF(sv)) {
+ Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Reference is not weak");
+ return sv;
+ }
+ else if (SvREADONLY(sv)) croak_no_modify();
+
+ tsv = SvRV(sv);
+ SvWEAKREF_off(sv);
+ SvROK_on(sv);
+ SvREFCNT_inc_NN(tsv);
+ Perl_sv_del_backref(aTHX_ tsv, sv);
+ return sv;
+}
+
+/*
=for apidoc sv_get_backrefs
If C<sv> is the target of a weak reference then it returns the back
goto freescalar;
case SVt_REGEXP:
/* FIXME for plugins */
- freeregexp:
pregfree2((REGEXP*) sv);
goto freescalar;
case SVt_PVCV:
}
else if (LvTYPE(sv) != 't') /* unless tie: unrefcnted fake SV** */
SvREFCNT_dec(LvTARG(sv));
- if (isREGEXP(sv)) goto freeregexp;
+ if (isREGEXP(sv)) {
+ /* SvLEN points to a regex body. Free the body, then
+ * set SvLEN to whatever value was in the now-freed
+ * regex body. The PVX buffer is shared by multiple re's
+ * and only freed once, by the re whose len in non-null */
+ STRLEN len = ReANY(sv)->xpv_len;
+ pregfree2((REGEXP*) sv);
+ SvLEN_set((sv), len);
+ goto freescalar;
+ }
/* FALLTHROUGH */
case SVt_PVGV:
if (isGV_with_GP(sv)) {
void
Perl_sv_vsetpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
- va_list *const args, SV **const svargs, const Size_t svmax, bool *const maybe_tainted)
+ va_list *const args, SV **const svargs, const Size_t sv_count, bool *const maybe_tainted)
{
PERL_ARGS_ASSERT_SV_VSETPVFN;
SvPVCLEAR(sv);
- sv_vcatpvfn_flags(sv, pat, patlen, args, svargs, svmax, maybe_tainted, 0);
+ sv_vcatpvfn_flags(sv, pat, patlen, args, svargs, sv_count, maybe_tainted, 0);
+}
+
+
+/* simplified inline Perl_sv_catpvn_nomg() when you know the SV's SvPOK */
+
+PERL_STATIC_INLINE void
+S_sv_catpvn_simple(pTHX_ SV *const sv, const char* const buf, const STRLEN len)
+{
+ STRLEN const need = len + SvCUR(sv) + 1;
+ char *end;
+
+ /* can't wrap as both len and SvCUR() are allocated in
+ * memory and together can't consume all the address space
+ */
+ assert(need > len);
+
+ assert(SvPOK(sv));
+ SvGROW(sv, need);
+ end = SvEND(sv);
+ Copy(buf, end, len, char);
+ end += len;
+ *end = '\0';
+ SvCUR_set(sv, need - 1);
}
*/
STATIC STRLEN
-S_expect_number(pTHX_ char **const pattern)
+S_expect_number(pTHX_ const char **const pattern)
{
STRLEN var;
void
Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
- va_list *const args, SV **const svargs, const Size_t svmax, bool *const maybe_tainted)
+ va_list *const args, SV **const svargs, const Size_t sv_count, bool *const maybe_tainted)
{
PERL_ARGS_ASSERT_SV_VCATPVFN;
- sv_vcatpvfn_flags(sv, pat, patlen, args, svargs, svmax, maybe_tainted, SV_GMAGIC|SV_SMAGIC);
+ sv_vcatpvfn_flags(sv, pat, patlen, args, svargs, sv_count, maybe_tainted, SV_GMAGIC|SV_SMAGIC);
}
#ifndef USE_LOCALE_NUMERIC
*p++ = '.';
#else
- if (PL_numeric_radix_sv) {
+ if (PL_numeric_radix_sv && IN_LC(LC_NUMERIC)) {
STRLEN n;
const char* r = SvPV(PL_numeric_radix_sv, n);
- assert(IN_LC(LC_NUMERIC));
Copy(r, p, n, char);
p += n;
}
void
Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
- va_list *const args, SV **const svargs, const Size_t svmax, bool *const maybe_tainted,
+ va_list *const args, SV **const svargs, const Size_t sv_count, bool *const maybe_tainted,
const U32 flags)
{
- char *p;
- char *q;
+ const char *fmtstart; /* character following the current '%' */
+ const char *q; /* current position within format */
const char *patend;
STRLEN origlen;
Size_t svix = 0;
SV *argsv = NULL;
bool has_utf8 = DO_UTF8(sv); /* has the result utf8? */
const bool pat_utf8 = has_utf8; /* the pattern is in utf8? */
- SV *nsv = NULL;
/* Times 4: a decimal digit takes more than 3 binary digits.
* NV_DIG: mantissa takes than many decimal digits.
* Plus 32: Playing safe. */
* warnings etc.
*/
- if (patlen == 0 && (args || svmax == 0))
+ if (patlen == 0 && (args || sv_count == 0))
return;
- if (patlen <= 4 && pat[0] == '%' && (args || svmax == 1)) {
+ if (patlen <= 4 && pat[0] == '%' && (args || sv_count == 1)) {
/* "%s" */
if (patlen == 2 && pat[1] == 's') {
patend = (char*)pat + patlen;
- for (p = (char*)pat; p < patend; p = q) {
-
+ for (fmtstart = pat; fmtstart < patend; fmtstart = q) {
char intsize = 0; /* size qualifier in "%hi..." etc */
bool alt = FALSE; /* has "%#..." */
bool left = FALSE; /* has "%-..." */
const char *eptr = NULL; /* the address of the element string */
STRLEN elen = 0; /* the length of the element string */
- const char *fmtstart; /* start of current format (the '%') */
char c; /* the actual format ('d', s' etc) */
/* echo everything up to the next format specification */
- for (q = p; q < patend && *q != '%'; ++q) ;
- if (q > p) {
- if (has_utf8 && !pat_utf8)
- sv_catpvn_nomg_utf8_upgrade(sv, p, q - p, nsv);
+ for (q = fmtstart; q < patend && *q != '%'; ++q)
+ {};
+
+ if (q > fmtstart) {
+ if (has_utf8 && !pat_utf8) {
+ /* upgrade and copy the bytes of fmtstart..q-1 to utf8 on
+ * the fly */
+ const char *p;
+ char *dst;
+ STRLEN need = SvCUR(sv) + (q - fmtstart) + 1;
+
+ for (p = fmtstart; p < q; p++)
+ if (!NATIVE_BYTE_IS_INVARIANT(*p))
+ need++;
+ SvGROW(sv, need);
+
+ dst = SvEND(sv);
+ for (p = fmtstart; p < q; p++)
+ append_utf8_from_native_byte((U8)*p, (U8**)&dst);
+ *dst = '\0';
+ SvCUR_set(sv, need - 1);
+ }
else
- sv_catpvn_nomg(sv, p, q - p);
- p = q;
+ S_sv_catpvn_simple(aTHX_ sv, fmtstart, q - fmtstart);
}
if (q++ >= patend)
break;
- fmtstart = q;
+ fmtstart = q; /* fmtstart is char following the '%' */
/*
We allow format specification elements in this order:
vecsv = va_arg(*args, SV*);
else {
ix = ix ? ix - 1 : svix++;
- vecsv = ix < svmax ? svargs[ix]
+ vecsv = ix < sv_count ? svargs[ix]
: (arg_missing = TRUE, &PL_sv_no);
}
dotstr = SvPV_const(vecsv, dotstrlen);
i = va_arg(*args, int);
else {
ix = ix ? ix - 1 : svix++;
- sv = (ix < svmax) ? svargs[ix]
+ sv = (ix < sv_count) ? svargs[ix]
: (arg_missing = TRUE, (SV*)NULL);
}
width = S_sprintf_arg_num_val(aTHX_ args, i, sv, &left);
i = va_arg(*args, int);
else {
ix = ix ? ix - 1 : svix++;
- sv = (ix < svmax) ? svargs[ix]
+ sv = (ix < sv_count) ? svargs[ix]
: (arg_missing = TRUE, (SV*)NULL);
}
precis = S_sprintf_arg_num_val(aTHX_ args, i, sv, &neg);
if (!args) {
efix = efix ? efix - 1 : svix++;
- argsv = efix < svmax ? svargs[efix]
+ argsv = efix < sv_count ? svargs[efix]
: (arg_missing = TRUE, &PL_sv_no);
}
* over the individual characters of a vector arg */
vector:
if (!veclen)
- goto donevalidconversion;
+ goto done_valid_conversion;
if (vec_utf8)
uv = utf8n_to_uvchr(vecstr, veclen, &ulen,
UTF8_ALLOW_ANYUV);
switch (base) {
case 16:
- p = (char *)((c == 'X') ? PL_hexdigit + 16 : PL_hexdigit);
- do {
- dig = uv & 15;
- *--ptr = p[dig];
- } while (uv >>= 4);
- if (alt && *ptr != '0') {
- esignbuf[esignlen++] = '0';
- esignbuf[esignlen++] = c; /* 'x' or 'X' */
- }
- break;
+ {
+ const char * const p =
+ (c == 'X') ? PL_hexdigit + 16 : PL_hexdigit;
+
+ do {
+ dig = uv & 15;
+ *--ptr = p[dig];
+ } while (uv >>= 4);
+ if (alt && *ptr != '0') {
+ esignbuf[esignlen++] = '0';
+ esignbuf[esignlen++] = c; /* 'x' or 'X' */
+ }
+ break;
+ }
case 8:
do {
dig = uv & 7;
lc_numeric_set = TRUE;
}
- if (PL_numeric_radix_sv) {
- assert(IN_LC(LC_NUMERIC));
+ if (PL_numeric_radix_sv && IN_LC(LC_NUMERIC)) {
/* this can't wrap unless PL_numeric_radix_sv is a string
* consuming virtually all the 32-bit or 64-bit address
* space
if (float_need < width)
float_need = width;
- if (PL_efloatsize < float_need) {
+ if (PL_efloatsize <= float_need) {
+ /* PL_efloatbuf should be at least 1 greater than
+ * float_need to allow a trailing \0 to be returned by
+ * snprintf(). If we need to grow, overgrow for the
+ * benefit of future generations */
+ const STRLEN extra = 0x20;
+ if (float_need >= ((STRLEN)~0) - extra)
+ croak_memory_wrap();
+ float_need += extra;
Safefree(PL_efloatbuf);
PL_efloatsize = float_need;
Newx(PL_efloatbuf, PL_efloatsize, char);
assert(elen);
assert(elen >= width);
+ S_sv_catpvn_simple(aTHX_ sv, eptr, elen);
- {
- /* unrolled Perl_sv_catpvn */
- STRLEN need = elen + SvCUR(sv) + 1;
- char *end;
- /* can't wrap as both elen and SvCUR() are allocated in
- * memory and together can't consume all the address space
- */
- assert(need > elen);
- SvGROW(sv, need);
- end = SvEND(sv);
- Copy(eptr, end, elen, char);
- end += elen;
- *end = '\0';
- SvCUR_set(sv, need - 1);
- }
-
- goto donevalidconversion;
+ goto done_valid_conversion;
}
/* SPECIAL */
PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
sv_setuv_mg(argsv, has_utf8 ? (UV)sv_len_utf8(sv) : (UV)len);
}
- goto donevalidconversion;
+ goto done_valid_conversion;
}
/* UNKNOWN */
/* mangled format: output the '%', then continue from the
* character following that */
- sv_catpvn_nomg(sv, p, 1);
- q = p + 1;
+ sv_catpvn_nomg(sv, fmtstart-1, 1);
+ q = fmtstart;
svix = osvix;
/* Any "redundant arg" warning from now onwards will probably
* just be misleading, so don't bother. */
goto vector; /* do next iteration */
}
- donevalidconversion:
+ done_valid_conversion:
if (arg_missing)
S_warn_vcatpvfn_missing_argument(aTHX);
/* Now that we've consumed all our printf format arguments (svix)
* do we have things left on the stack that we didn't use?
*/
- if (!no_redundant_warning && svmax >= svix + 1 && ckWARN(WARN_REDUNDANT)) {
+ if (!no_redundant_warning && sv_count >= svix + 1 && ckWARN(WARN_REDUNDANT)) {
Perl_warner(aTHX_ packWARN(WARN_REDUNDANT), "Redundant argument in %s",
PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
}
case SVt_REGEXP:
duprex:
/* FIXME for plugins */
- dstr->sv_u.svu_rx = ((REGEXP *)dstr)->sv_any;
re_dup_guts((REGEXP*) sstr, (REGEXP*) dstr, param);
break;
case SVt_PVLV:
init_constants();
ptr_table_store(PL_ptr_table, &proto_perl->Isv_undef, &PL_sv_undef);
ptr_table_store(PL_ptr_table, &proto_perl->Isv_no, &PL_sv_no);
+ ptr_table_store(PL_ptr_table, &proto_perl->Isv_zero, &PL_sv_zero);
ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes);
ptr_table_store(PL_ptr_table, &proto_perl->Ipadname_const,
&PL_padname_const);
PL_numeric_radix_sv = sv_dup_inc(proto_perl->Inumeric_radix_sv, param);
#endif /* !USE_LOCALE_NUMERIC */
+ PL_langinfo_buf = NULL;
+ PL_langinfo_bufsize = 0;
+
/* Unicode inversion lists */
PL_Latin1 = sv_dup_inc(proto_perl->ILatin1, param);
PL_UpperLatin1 = sv_dup_inc(proto_perl->IUpperLatin1, param);
|SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
|SVp_POK|SVf_POK;
+ SvANY(&PL_sv_zero) = new_XPVNV();
+ SvREFCNT(&PL_sv_zero) = SvREFCNT_IMMORTAL;
+ SvFLAGS(&PL_sv_zero) = SVt_PVNV|SVf_READONLY|SVf_PROTECT
+ |SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
+ |SVp_POK|SVf_POK
+ |SVs_PADTMP;
+
SvPV_set(&PL_sv_no, (char*)PL_No);
SvCUR_set(&PL_sv_no, 0);
SvLEN_set(&PL_sv_no, 0);
SvIV_set(&PL_sv_yes, 1);
SvNV_set(&PL_sv_yes, 1);
+ SvPV_set(&PL_sv_zero, (char*)PL_Zero);
+ SvCUR_set(&PL_sv_zero, 1);
+ SvLEN_set(&PL_sv_zero, 0);
+ SvIV_set(&PL_sv_zero, 0);
+ SvNV_set(&PL_sv_zero, 0);
+
PadnamePV(&PL_padname_const) = (char *)PL_No;
+
+ assert(SvIMMORTAL_INTERP(&PL_sv_yes));
+ assert(SvIMMORTAL_INTERP(&PL_sv_undef));
+ assert(SvIMMORTAL_INTERP(&PL_sv_no));
+ assert(SvIMMORTAL_INTERP(&PL_sv_zero));
+
+ assert(SvIMMORTAL(&PL_sv_yes));
+ assert(SvIMMORTAL(&PL_sv_undef));
+ assert(SvIMMORTAL(&PL_sv_no));
+ assert(SvIMMORTAL(&PL_sv_zero));
+
+ assert( SvIMMORTAL_TRUE(&PL_sv_yes));
+ assert(!SvIMMORTAL_TRUE(&PL_sv_undef));
+ assert(!SvIMMORTAL_TRUE(&PL_sv_no));
+ assert(!SvIMMORTAL_TRUE(&PL_sv_zero));
+
+ assert( SvTRUE_nomg_NN(&PL_sv_yes));
+ assert(!SvTRUE_nomg_NN(&PL_sv_undef));
+ assert(!SvTRUE_nomg_NN(&PL_sv_no));
+ assert(!SvTRUE_nomg_NN(&PL_sv_zero));
}
/*
/* def-ness of rval pos() is independent of the def-ness of its arg */
if ( !(obase->op_flags & OPf_MOD))
break;
+ /* FALLTHROUGH */
case OP_SCHOMP:
case OP_CHOMP:
https://perl5.git.perl.org / perl5.git / blobdiff