if (PL_op)
Perl_warner(aTHX_ packWARN(WARN_NUMERIC),
+ /* diag_listed_as: Argument "%s" isn't numeric%s */
"Argument \"%s\" isn't numeric in %s", pv,
OP_DESC(PL_op));
else
Perl_warner(aTHX_ packWARN(WARN_NUMERIC),
+ /* diag_listed_as: Argument "%s" isn't numeric%s */
"Argument \"%s\" isn't numeric", pv);
}
Converts the PV of an SV to its UTF-8-encoded form.
Forces the SV to string form if it is not already.
Always sets the SvUTF8 flag to avoid future validity checks even
-if all the bytes are invariant in UTF-8. If C<flags> has C<SV_GMAGIC> bit set,
+if all the bytes are invariant in UTF-8.
+If C<flags> has C<SV_GMAGIC> bit set,
will C<mg_get> on C<sv> if appropriate, else not.
Returns the number of bytes in the converted string
C<sv_utf8_upgrade> and
* we want to make sure everything inside is valid utf8 first.
*/
c = start = (const U8 *) SvPVX_const(sv);
- if (!is_utf8_string(c, SvCUR(sv)+1))
+ if (!is_utf8_string(c, SvCUR(sv)))
return FALSE;
e = (const U8 *) SvEND(sv);
while (c < e) {
if ( SvVOK(dstr) )
{
/* need to nuke the magic */
- mg_free(dstr);
+ sv_unmagic(dstr, PERL_MAGIC_vstring);
}
/* There's a lot of redundancy below but we're going for speed here */
{
const char * const type = sv_reftype(sstr,0);
if (PL_op)
+ /* diag_listed_as: Bizarre copy of %s */
Perl_croak(aTHX_ "Bizarre copy of %s in %s", type, OP_DESC(PL_op));
else
Perl_croak(aTHX_ "Bizarre copy of %s", type);
/* len is STRLEN which is unsigned, need to copy to signed */
const IV iv = len;
if (iv < 0)
- Perl_croak(aTHX_ "panic: sv_setpvn called with negative strlen");
+ Perl_croak(aTHX_ "panic: sv_setpvn called with negative strlen %"
+ IVdf, iv);
}
SvUPGRADE(sv, SVt_PV);
svp = mg ? &(mg->mg_obj) : NULL;
}
- if (!svp || !*svp)
- Perl_croak(aTHX_ "panic: del_backref");
+ if (!svp)
+ Perl_croak(aTHX_ "panic: del_backref, svp=0");
+ if (!*svp) {
+ /* It's possible that sv is being freed recursively part way through the
+ freeing of tsv. If this happens, the backreferences array of tsv has
+ already been freed, and so svp will be NULL. If this is the case,
+ we should not panic. Instead, nothing needs doing, so return. */
+ if (PL_phase == PERL_PHASE_DESTRUCT && SvREFCNT(tsv) == 0)
+ return;
+ Perl_croak(aTHX_ "panic: del_backref, *svp=%p phase=%s refcnt=%" UVuf,
+ *svp, PL_phase_names[PL_phase], SvREFCNT(tsv));
+ }
if (SvTYPE(*svp) == SVt_PVAV) {
#ifdef DEBUGGING
assert(count ==1);
AvFILLp(av) = fill-1;
}
+ else if (SvIS_FREED(*svp) && PL_phase == PERL_PHASE_DESTRUCT) {
+ /* freed AV; skip */
+ }
else {
/* optimisation: only a single backref, stored directly */
if (*svp != sv)
- Perl_croak(aTHX_ "panic: del_backref");
+ Perl_croak(aTHX_ "panic: del_backref, *svp=%p, sv=%p", *svp, sv);
*svp = NULL;
}
PERL_ARGS_ASSERT_SV_INSERT_FLAGS;
if (!bigstr)
- Perl_croak(aTHX_ "Can't modify non-existent substring");
+ Perl_croak(aTHX_ "Can't modify nonexistent substring");
SvPV_force_flags(bigstr, curlen, flags);
(void)SvPOK_only_UTF8(bigstr);
if (offset + len > curlen) {
bigend = big + SvCUR(bigstr);
if (midend > bigend)
- Perl_croak(aTHX_ "panic: sv_insert");
+ Perl_croak(aTHX_ "panic: sv_insert, midend=%p, bigend=%p",
+ midend, bigend);
if (mid - big > bigend - midend) { /* faster to shorten from end */
if (littlelen) {
Safefree(IoTOP_NAME(sv));
Safefree(IoFMT_NAME(sv));
Safefree(IoBOTTOM_NAME(sv));
+ if ((const GV *)sv == PL_statgv)
+ PL_statgv = NULL;
goto freescalar;
case SVt_REGEXP:
/* FIXME for plugins */
/* See also S_sv_unglob, which does the same thing. */
if ((const GV *)sv == PL_last_in_gv)
PL_last_in_gv = NULL;
+ else if ((const GV *)sv == PL_statgv)
+ PL_statgv = NULL;
case SVt_PVMG:
case SVt_PVNV:
case SVt_PVIV:
/*
=for apidoc sv_len
-Returns the length of the string in the SV. Handles magic and type
+Returns the length of the string in the SV. Handles magic and type
coercion. See also C<SvCUR>, which gives raw access to the xpv_cur slot.
=cut
Converts the value pointed to by offsetp from a count of UTF-8 chars from
the start of the string, to a count of the equivalent number of bytes; if
lenp is non-zero, it does the same to lenp, but this time starting from
-the offset, rather than from the start of the string. Handles type coercion.
+the offset, rather than from the start
+of the string. Handles type coercion.
I<flags> is passed to C<SvPV_flags>, and usually should be
C<SV_GMAGIC|SV_CONST_RETURN> to handle magic.
Converts the value pointed to by offsetp from a count of UTF-8 chars from
the start of the string, to a count of the equivalent number of bytes; if
lenp is non-zero, it does the same to lenp, but this time starting from
-the offset, rather than from the start of the string. Handles magic and
+the offset, rather than from the start of the string. Handles magic and
type coercion.
Use C<sv_pos_u2b_flags> in preference, which correctly handles strings longer
s = (const U8*)SvPV_const(sv, blen);
if (blen < byte)
- Perl_croak(aTHX_ "panic: sv_pos_b2u: bad byte offset");
+ Perl_croak(aTHX_ "panic: sv_pos_b2u: bad byte offset, blen=%"UVuf
+ ", byte=%"UVuf, (UV)blen, (UV)byte);
send = s + byte;
const NV was = SvNVX(sv);
if (NV_OVERFLOWS_INTEGERS_AT &&
was >= NV_OVERFLOWS_INTEGERS_AT) {
+ /* diag_listed_as: Lost precision when %s %f by 1 */
Perl_ck_warner(aTHX_ packWARN(WARN_IMPRECISION),
"Lost precision when incrementing %" NVff " by 1",
was);
const NV was = SvNVX(sv);
if (NV_OVERFLOWS_INTEGERS_AT &&
was <= -NV_OVERFLOWS_INTEGERS_AT) {
+ /* diag_listed_as: Lost precision when %s %f by 1 */
Perl_ck_warner(aTHX_ packWARN(WARN_IMPRECISION),
"Lost precision when decrementing %" NVff " by 1",
was);
Marks an existing SV as mortal. The SV will be destroyed "soon", either
by an explicit call to FREETMPS, or by an implicit call at places such as
statement boundaries. SvTEMP() is turned on which means that the SV's
-string buffer can be "stolen" if this SV is copied. See also C<sv_newmortal>
+string buffer can be "stolen" if this SV is copied. See also C<sv_newmortal>
and C<sv_mortalcopy>.
=cut
if ((const GV *)sv == PL_last_in_gv)
PL_last_in_gv = NULL;
+ else if ((const GV *)sv == PL_statgv)
+ PL_statgv = NULL;
}
/*
}
}
else
- sv_setuv_mg(argsv, (UV)i);
+ sv_setuv_mg(argsv, has_utf8 ? (UV)sv_len_utf8(sv) : (UV)i);
continue; /* not "break" */
/* UNKNOWN */
The foo_dup() functions make an exact copy of an existing foo thingy.
During the course of a cloning, a hash table is used to map old addresses
-to new addresses. The table is created and manipulated with the
+to new addresses. The table is created and manipulated with the
ptr_table_* functions.
=cut
register const Direntry_t *dirent;
char smallbuf[256];
char *name = NULL;
- STRLEN len = -1;
+ STRLEN len = 0;
long pos;
#endif
return dstr;
}
}
+ else if (SvTYPE(sstr) == SVt_PVGV && !SvFAKE(sstr)) {
+ HV *stash = GvSTASH(sstr);
+ const HEK * hvname;
+ if (stash && (hvname = HvNAME_HEK(stash))) {
+ /** don't clone GVs if they already exist **/
+ SV **svp;
+ stash = gv_stashpvn(HEK_KEY(hvname), HEK_LEN(hvname),
+ HEK_UTF8(hvname) ? SVf_UTF8 : 0);
+ svp = hv_fetch(
+ stash, GvNAME(sstr),
+ GvNAMEUTF8(sstr)
+ ? -GvNAMELEN(sstr)
+ : GvNAMELEN(sstr),
+ 0
+ );
+ if (svp && *svp && SvTYPE(*svp) == SVt_PVGV) {
+ ptr_table_store(PL_ptr_table, sstr, *svp);
+ return *svp;
+ }
+ }
+ }
}
/* create anew and remember what it is */
from the position which (PV + *offset) pointed to. The dsv will be
concatenated the decoded UTF-8 string from ssv. Decoding will terminate
when the string tstr appears in decoding output or the input ends on
-the PV of the ssv. The value which the offset points will be modified
+the PV of the ssv. The value which the offset points will be modified
to the last input position on the ssv.
Returns TRUE if the terminator was found, else returns FALSE.
{
SV * const name = sv_newmortal();
- if (gv) {
+ if (gv && isGV(gv)) {
char buffer[2];
buffer[0] = gvtype;
buffer[1] = 0;
}
}
else {
- CV * const cv = find_runcv(NULL);
+ CV * const cv = gv ? (CV *)gv : find_runcv(NULL);
SV *sv;
AV *av;
+ assert(!cv || SvTYPE(cv) == SVt_PVCV);
+
if (!cv || !CvPADLIST(cv))
return NULL;
av = MUTABLE_AV((*av_fetch(CvPADLIST(cv), 0, FALSE)));
https://perl5.git.perl.org / perl5.git / blobdiff