=cut
*/
-int
+/* prior to 5.000 stable, this function returned the new OOK-less SvFLAGS
+ prior to 5.23.4 this function always returned 0
+*/
+
+void
Perl_sv_backoff(SV *const sv)
{
STRLEN delta;
SvLEN_set(sv, SvLEN(sv) + delta);
SvPV_set(sv, SvPVX(sv) - delta);
- Move(s, SvPVX(sv), SvCUR(sv)+1, char);
SvFLAGS(sv) &= ~SVf_OOK;
- return 0;
+ Move(s, SvPVX(sv), SvCUR(sv)+1, char);
+ return;
}
/*
=for apidoc sv_2iv_flags
Return the integer value of an SV, doing any necessary string
-conversion. If C<flags> includes C<SV_GMAGIC>, does an C<mg_get()> first.
+conversion. If C<flags> has the C<SV_GMAGIC> bit set, does an C<mg_get()> first.
Normally used via the C<SvIV(sv)> and C<SvIVx(sv)> macros.
=cut
=for apidoc sv_2uv_flags
Return the unsigned integer value of an SV, doing any necessary string
-conversion. If C<flags> includes C<SV_GMAGIC>, does an C<mg_get()> first.
+conversion. If C<flags> has the C<SV_GMAGIC> bit set, does an C<mg_get()> first.
Normally used via the C<SvUV(sv)> and C<SvUVx(sv)> macros.
=cut
=for apidoc sv_2nv_flags
Return the num value of an SV, doing any necessary string or integer
-conversion. If C<flags> includes C<SV_GMAGIC>, does an C<mg_get()> first.
+conversion. If C<flags> has the C<SV_GMAGIC> bit set, does an C<mg_get()> first.
Normally used via the C<SvNV(sv)> and C<SvNVx(sv)> macros.
=cut
=for apidoc sv_2pv_flags
Returns a pointer to the string value of an SV, and sets C<*lp> to its length.
-If flags includes C<SV_GMAGIC>, does an C<mg_get()> first. Coerces C<sv> to a
+If flags has the C<SV_GMAGIC> bit set, does an C<mg_get()> first. Coerces C<sv> to a
string if necessary. Normally invoked via the C<SvPV_flags> macro.
C<sv_2pv()> and C<sv_2pv_nomg> usually end up here too.
=for apidoc sv_copypv_flags
Implementation of C<sv_copypv> and C<sv_copypv_nomg>. Calls get magic iff flags
-include C<SV_GMAGIC>.
+has the C<SV_GMAGIC> bit set.
=cut
*/
Concatenates the string from SV C<ssv> onto the end of the string in SV
C<dsv>. If C<ssv> is null, does nothing; otherwise modifies only C<dsv>.
-If C<flags> include C<SV_GMAGIC> bit set, will call C<mg_get> on both SVs if
-appropriate. If C<flags> include C<SV_SMAGIC>, C<mg_set> will be called on
+If C<flags> has the C<SV_GMAGIC> bit set, will call C<mg_get> on both SVs if
+appropriate. If C<flags> has the C<SV_SMAGIC> bit set, C<mg_set> will be called on
the modified SV afterward, if appropriate. C<sv_catsv>, C<sv_catsv_nomg>,
and C<sv_catsv_mg> are implemented in terms of this function.
Decrement an SV's reference count, and if it drops to zero, call
C<sv_clear> to invoke destructors and free up any memory used by
-the body; finally, deallocate the SV's head itself.
+the body; finally, deallocating the SV's head itself.
Normally called via a wrapper macro C<SvREFCNT_dec>.
=cut
Returns a boolean indicating whether the strings in the two SVs are
identical. Is UTF-8 and S<C<'use bytes'>> aware and coerces its args to strings
-if necessary. If C<flags> includes C<SV_GMAGIC>, it handles get-magic, too.
+if necessary. If the flags has the C<SV_GMAGIC> bit set, it handles get-magic, too.
=cut
*/
Compares the strings in two SVs. Returns -1, 0, or 1 indicating whether the
string in C<sv1> is less than, equal to, or greater than the string in
C<sv2>. Is UTF-8 and S<C<'use bytes'>> aware and will coerce its args to strings
-if necessary. If the flags includes C<SV_GMAGIC>, it handles get magic. See
+if necessary. If the flags has the C<SV_GMAGIC> bit set, it handles get magic. See
also C<L</sv_cmp_locale_flags>>.
=cut
return;
}
+ /* treat AV/HV/CV/FM/IO and non-fake GVs as immutable */
+ if (SvTYPE(sv) >= SVt_PVAV || (isGV_with_GP(sv) && !SvFAKE(sv)))
+ Perl_croak_no_modify();
+
if (!(flags & SVp_POK) || !*SvPVX_const(sv)) {
if ((flags & SVTYPEMASK) < SVt_PVIV)
sv_upgrade(sv, ((flags & SVTYPEMASK) > SVt_IV ? SVt_PVIV : SVt_IV));
return;
}
}
+
+ /* treat AV/HV/CV/FM/IO and non-fake GVs as immutable */
+ if (SvTYPE(sv) >= SVt_PVAV || (isGV_with_GP(sv) && !SvFAKE(sv)))
+ Perl_croak_no_modify();
+
if (!(flags & SVp_POK)) {
if ((flags & SVTYPEMASK) < SVt_PVIV)
sv_upgrade(sv, ((flags & SVTYPEMASK) > SVt_IV) ? SVt_PVIV : SVt_IV);
=for apidoc sv_pvn_force_flags
Get a sensible string out of the SV somehow.
-If C<flags> has C<SV_GMAGIC> bit set, will C<mg_get> on C<sv> if
+If C<flags> has the C<SV_GMAGIC> bit set, will C<mg_get> on C<sv> if
appropriate, else not. C<sv_pvn_force> and C<sv_pvn_force_nomg> are
implemented in terms of this function.
You normally want to use the various wrapper macros instead: see
Returns a string describing what the SV is a reference to.
+If ob is true and the SV is blessed, the string is the class name,
+otherwise it is the type of the SV, "SCALAR", "ARRAY" etc.
+
=cut
*/
Returns a SV describing what the SV passed in is a reference to.
+dst can be a SV to be set to the description or NULL, in which case a
+mortal SV is returned.
+
+If ob is true and the SV is blessed, the description is the class
+name, otherwise it is the type of the SV, "SCALAR", "ARRAY" etc.
+
=cut
*/
C<maybe_tainted> if results are untrustworthy (often due to the use of
locales).
-If called as C<sv_vcatpvfn> or flags include C<SV_GMAGIC>, calls get magic.
+If called as C<sv_vcatpvfn> or flags has the C<SV_GMAGIC> bit set, calls get magic.
Usually used via one of its frontends C<sv_vcatpvf> and C<sv_vcatpvf_mg>.
is safe. */
is_utf8 = (bool)va_arg(*args, int);
elen = va_arg(*args, UV);
- if ((IV)elen < 0) {
- /* check if utf8 length is larger than 0 when cast to IV */
- assert( (IV)elen >= 0 ); /* in DEBUGGING build we want to crash */
+ /* if utf8 length is larger than 0x7ffff..., then it might
+ * have been a signed value that wrapped */
+ if (elen > ((~(STRLEN)0) >> 1)) {
+ assert(0); /* in DEBUGGING build we want to crash */
elen= 0; /* otherwise we want to treat this as an empty string */
}
eptr = va_arg(*args, char *);
# endif
#endif
- if (fv < 0)
+ if (fv < 0
+ || Perl_signbit(fv)
+ )
*p++ = '-';
else if (plus)
*p++ = plus;
*p++ = xdig[*v++];
/* The radix is always output after the first
- * non-zero xdigit, or if alt. */
- if (vfnz < vlnz || alt) {
+ * non-zero xdigit, or if precis, or if alt. */
+ if (vfnz < vlnz || precis > 0 || alt) {
#ifndef USE_LOCALE_NUMERIC
*p++ = '.';
#else
elen = quadmath_snprintf(PL_efloatbuf, PL_efloatsize,
qfmt, nv);
if ((IV)elen == -1)
- Perl_croak_nocontext("panic: quadmath_snprintf failed, format \"%s|'", qfmt);
+ Perl_croak_nocontext("panic: quadmath_snprintf failed, format \"%s\"", qfmt);
if (qfmt != ptr)
Safefree(qfmt);
}
}
}
- assert((IV)elen >= 0); /* here zero elen is fine */
+ /* signed value that's wrapped? */
+ assert(elen <= ((~(STRLEN)0) >> 1));
have = esignlen + zeros + elen;
if (have < zeros)
croak_memory_wrap();
return ret;
/* create anew and remember what it is */
+#ifdef __amigaos4__
+ ret = PerlIO_fdupopen(aTHX_ fp, param, PERLIO_DUP_CLONE|PERLIO_DUP_FD);
+#else
ret = PerlIO_fdupopen(aTHX_ fp, param, PERLIO_DUP_CLONE);
+#endif
ptr_table_store(PL_ptr_table, fp, ret);
return ret;
}
/* perlhost.h so we need to call into it
to clone the host, CPerlHost should have a c interface, sky */
+#ifndef __amigaos4__
if (flags & CLONEf_CLONE_HOST) {
return perl_clone_host(proto_perl,flags);
}
+#endif
return perl_clone_using(proto_perl, flags,
proto_perl->IMem,
proto_perl->IMemShared,
C<encoding> is assumed to be an C<Encode> object, the PV of C<ssv> is
assumed to be octets in that encoding and decoding the input starts
from the position which S<C<(PV + *offset)>> pointed to. C<dsv> will be
-concatenated the decoded UTF-8 string from C<ssv>. Decoding will terminate
+concatenated with the decoded UTF-8 string from C<ssv>. Decoding will terminate
when the string C<tstr> appears in decoding output or the input ends on
the PV of C<ssv>. The value which C<offset> points will be modified
to the last input position on C<ssv>.
https://perl5.git.perl.org / perl5.git / blobdiff