This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Re: Cygwin PerlIO.t failing
[perl5.git]
/
sv.c
diff --git
a/sv.c
b/sv.c
index
2dfc8d4
..
ef61d1b
100644
(file)
--- a/
sv.c
+++ b/
sv.c
@@
-199,7
+199,7
@@
S_del_sv(pTHX_ SV *p)
}
if (!ok) {
if (ckWARN_d(WARN_INTERNAL))
}
if (!ok) {
if (ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_
WARN_INTERNAL
,
+ Perl_warner(aTHX_
packWARN(WARN_INTERNAL)
,
"Attempt to free non-arena SV: 0x%"UVxf,
PTR2UV(p));
return;
"Attempt to free non-arena SV: 0x%"UVxf,
PTR2UV(p));
return;
@@
-546,10
+546,10
@@
void
Perl_report_uninit(pTHX)
{
if (PL_op)
Perl_report_uninit(pTHX)
{
if (PL_op)
- Perl_warner(aTHX_
WARN_UNINITIALIZED
, PL_warn_uninit,
+ Perl_warner(aTHX_
packWARN(WARN_UNINITIALIZED)
, PL_warn_uninit,
" in ", OP_DESC(PL_op));
else
" in ", OP_DESC(PL_op));
else
- Perl_warner(aTHX_
WARN_UNINITIALIZED
, PL_warn_uninit, "", "");
+ Perl_warner(aTHX_
packWARN(WARN_UNINITIALIZED)
, PL_warn_uninit, "", "");
}
/* grab a new IV body from the free list, allocating more if necessary */
}
/* grab a new IV body from the free list, allocating more if necessary */
@@
-1226,13
+1226,13
@@
You generally want to use the C<SvUPGRADE> macro wrapper. See also C<svtype>.
bool
Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
{
bool
Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
{
- char* pv;
- U32 cur;
- U32 len;
- IV iv;
- NV nv;
- MAGIC* magic;
- HV* stash;
+ char* pv
= NULL
;
+ U32 cur
= 0
;
+ U32 len
= 0
;
+ IV iv
= 0
;
+ NV nv
= 0.0
;
+ MAGIC* magic
= NULL
;
+ HV* stash
= Nullhv
;
if (mt != SVt_PV && SvREADONLY(sv) && SvFAKE(sv)) {
sv_force_normal(sv);
if (mt != SVt_PV && SvREADONLY(sv) && SvFAKE(sv)) {
sv_force_normal(sv);
@@
-1540,6
+1540,8
@@
Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen)
{
register char *s;
{
register char *s;
+
+
#ifdef HAS_64K_LIMIT
if (newlen >= 0x10000) {
PerlIO_printf(Perl_debug_log,
#ifdef HAS_64K_LIMIT
if (newlen >= 0x10000) {
PerlIO_printf(Perl_debug_log,
@@
-1565,6
+1567,7
@@
Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen)
}
else
s = SvPVX(sv);
}
else
s = SvPVX(sv);
+
if (newlen > SvLEN(sv)) { /* need more room? */
if (SvLEN(sv) && s) {
#if defined(MYMALLOC) && !defined(LEAKTEST)
if (newlen > SvLEN(sv)) { /* need more room? */
if (SvLEN(sv) && s) {
#if defined(MYMALLOC) && !defined(LEAKTEST)
@@
-1585,7
+1588,7
@@
Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen)
}
New(703, s, newlen, char);
if (SvPVX(sv) && SvCUR(sv)) {
}
New(703, s, newlen, char);
if (SvPVX(sv) && SvCUR(sv)) {
- Move(SvPVX(sv), s, SvCUR(sv), char);
+ Move(SvPVX(sv), s,
(newlen < SvCUR(sv)) ? newlen :
SvCUR(sv), char);
}
}
SvPV_set(sv, s);
}
}
SvPV_set(sv, s);
@@
-1824,11
+1827,11
@@
S_not_a_number(pTHX_ SV *sv)
}
if (PL_op)
}
if (PL_op)
- Perl_warner(aTHX_
WARN_NUMERIC
,
+ Perl_warner(aTHX_
packWARN(WARN_NUMERIC)
,
"Argument \"%s\" isn't numeric in %s", pv,
OP_DESC(PL_op));
else
"Argument \"%s\" isn't numeric in %s", pv,
OP_DESC(PL_op));
else
- Perl_warner(aTHX_
WARN_NUMERIC
,
+ Perl_warner(aTHX_
packWARN(WARN_NUMERIC)
,
"Argument \"%s\" isn't numeric", pv);
}
"Argument \"%s\" isn't numeric", pv);
}
@@
-2872,8
+2875,8
@@
uiv_2buf(char *buf, IV iv, UV uv, int is_uv, char **peob)
return ptr;
}
return ptr;
}
-/*
For backwards-compatibility only. sv_2pv() is normally #def'ed to
- *
C<sv_2pv_macro()>. See also C<sv_2pv_flags()>.
+/*
sv_2pv() is now a macro using Perl_sv_2pv_flags();
+ *
this function provided for binary compatibility only
*/
char *
*/
char *
@@
-3152,10
+3155,10
@@
Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
Copies a stringified representation of the source SV into the
destination SV. Automatically performs any necessary mg_get and
Copies a stringified representation of the source SV into the
destination SV. Automatically performs any necessary mg_get and
-coercion of numeric values into strings. Guaranteed to preserve
+coercion of numeric values into strings. Guaranteed to preserve
UTF-8 flag even from overloaded objects. Similar in nature to
UTF-8 flag even from overloaded objects. Similar in nature to
-sv_2pv[_flags] but operates directly on an SV instead of just the
-string. Mostly uses sv_2pv_flags to do its work, except when that
+sv_2pv[_flags] but operates directly on an SV instead of just the
+string. Mostly uses sv_2pv_flags to do its work, except when that
would lose the UTF-8'ness of the PV.
=cut
would lose the UTF-8'ness of the PV.
=cut
@@
-3313,9
+3316,17
@@
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 have hibit clear.
Always sets the SvUTF8 flag to avoid future validity checks even
if all the bytes have hibit clear.
+This is not as a general purpose byte encoding to Unicode interface:
+use the Encode extension for that.
+
=cut
*/
=cut
*/
+/* sv_utf8_upgrade() is now a macro using sv_utf8_upgrade_flags();
+ * this function provided for binary compatibility only
+ */
+
+
STRLEN
Perl_sv_utf8_upgrade(pTHX_ register SV *sv)
{
STRLEN
Perl_sv_utf8_upgrade(pTHX_ register SV *sv)
{
@@
-3332,6
+3343,9
@@
if all the bytes have hibit clear. If C<flags> has C<SV_GMAGIC> bit set,
will C<mg_get> on C<sv> if appropriate, else not. C<sv_utf8_upgrade> and
C<sv_utf8_upgrade_nomg> are implemented in terms of this function.
will C<mg_get> on C<sv> if appropriate, else not. C<sv_utf8_upgrade> and
C<sv_utf8_upgrade_nomg> are implemented in terms of this function.
+This is not as a general purpose byte encoding to Unicode interface:
+use the Encode extension for that.
+
=cut
*/
=cut
*/
@@
-3397,6
+3411,9
@@
This may not be possible if the PV contains non-byte encoding characters;
if this is the case, either returns false or, if C<fail_ok> is not
true, croaks.
if this is the case, either returns false or, if C<fail_ok> is not
true, croaks.
+This is not as a general purpose Unicode to byte encoding interface:
+use the Encode extension for that.
+
=cut
*/
=cut
*/
@@
-3504,9
+3521,10
@@
C<SvSetMagicSV_nosteal>.
=cut
*/
=cut
*/
-/* sv_setsv() is aliased to Perl_sv_setsv_macro; this function provided
- for binary compatibility only
-*/
+/* sv_setsv() is now a macro using Perl_sv_setsv_flags();
+ * this function provided for binary compatibility only
+ */
+
void
Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
{
void
Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
{
@@
-3784,7
+3802,7
@@
Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
|| sv_cmp(cv_const_sv(cv),
cv_const_sv((CV*)sref)))))
{
|| sv_cmp(cv_const_sv(cv),
cv_const_sv((CV*)sref)))))
{
- Perl_warner(aTHX_
WARN_REDEFINE
,
+ Perl_warner(aTHX_
packWARN(WARN_REDEFINE)
,
CvCONST(cv)
? "Constant subroutine %s redefined"
: "Subroutine %s redefined",
CvCONST(cv)
? "Constant subroutine %s redefined"
: "Subroutine %s redefined",
@@
-3908,7
+3926,6
@@
Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
}
else { /* have to copy actual string */
STRLEN len = SvCUR(sstr);
}
else { /* have to copy actual string */
STRLEN len = SvCUR(sstr);
-
SvGROW(dstr, len + 1); /* inlined from sv_setpvn */
Move(SvPVX(sstr),SvPVX(dstr),len,char);
SvCUR_set(dstr, len);
SvGROW(dstr, len + 1); /* inlined from sv_setpvn */
Move(SvPVX(sstr),SvPVX(dstr),len,char);
SvCUR_set(dstr, len);
@@
-3964,7
+3981,7
@@
Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
else {
if (dtype == SVt_PVGV) {
if (ckWARN(WARN_MISC))
else {
if (dtype == SVt_PVGV) {
if (ckWARN(WARN_MISC))
- Perl_warner(aTHX_
WARN_MISC
, "Undefined value assigned to typeglob");
+ Perl_warner(aTHX_
packWARN(WARN_MISC)
, "Undefined value assigned to typeglob");
}
else
(void)SvOK_off(dstr);
}
else
(void)SvOK_off(dstr);
@@
-4236,9
+4253,10
@@
Handles 'get' magic, but not 'set' magic. See C<sv_catpvn_mg>.
=cut
*/
=cut
*/
-/* sv_catpvn() is aliased to Perl_sv_catpvn_macro; this function provided
- for binary compatibility only
-*/
+/* sv_catpvn() is now a macro using Perl_sv_catpvn_flags();
+ * this function provided for binary compatibility only
+ */
+
void
Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen)
{
void
Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen)
{
@@
-4299,9
+4317,10
@@
not 'set' magic. See C<sv_catsv_mg>.
=cut */
=cut */
-/* sv_catsv() is aliased to Perl_sv_catsv_macro; this function provided
- for binary compatibility only
-*/
+/* sv_catsv() is now a macro using Perl_sv_catsv_flags();
+ * this function provided for binary compatibility only
+ */
+
void
Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr)
{
void
Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr)
{
@@
-4731,7
+4750,7
@@
Perl_sv_rvweaken(pTHX_ SV *sv)
Perl_croak(aTHX_ "Can't weaken a nonreference");
else if (SvWEAKREF(sv)) {
if (ckWARN(WARN_MISC))
Perl_croak(aTHX_ "Can't weaken a nonreference");
else if (SvWEAKREF(sv)) {
if (ckWARN(WARN_MISC))
- Perl_warner(aTHX_
WARN_MISC
, "Reference is already weak");
+ Perl_warner(aTHX_
packWARN(WARN_MISC)
, "Reference is already weak");
return sv;
}
tsv = SvRV(sv);
return sv;
}
tsv = SvRV(sv);
@@
-4771,7
+4790,7
@@
S_sv_del_backref(pTHX_ SV *sv)
SV **svp;
I32 i;
SV *tsv = SvRV(sv);
SV **svp;
I32 i;
SV *tsv = SvRV(sv);
- MAGIC *mg;
+ MAGIC *mg
= NULL
;
if (!SvMAGICAL(tsv) || !(mg = mg_find(tsv, PERL_MAGIC_backref)))
Perl_croak(aTHX_ "panic: del_backref");
av = (AV *)mg->mg_obj;
if (!SvMAGICAL(tsv) || !(mg = mg_find(tsv, PERL_MAGIC_backref)))
Perl_croak(aTHX_ "panic: del_backref");
av = (AV *)mg->mg_obj;
@@
-4898,7
+4917,7
@@
Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv)
U32 refcnt = SvREFCNT(sv);
SV_CHECK_THINKFIRST(sv);
if (SvREFCNT(nsv) != 1 && ckWARN_d(WARN_INTERNAL))
U32 refcnt = SvREFCNT(sv);
SV_CHECK_THINKFIRST(sv);
if (SvREFCNT(nsv) != 1 && ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_
WARN_INTERNAL
, "Reference miscount in sv_replace()");
+ Perl_warner(aTHX_
packWARN(WARN_INTERNAL)
, "Reference miscount in sv_replace()");
if (SvMAGICAL(sv)) {
if (SvMAGICAL(nsv))
mg_free(nsv);
if (SvMAGICAL(sv)) {
if (SvMAGICAL(nsv))
mg_free(nsv);
@@
-5173,7
+5192,7
@@
Perl_sv_free(pTHX_ SV *sv)
return;
}
if (ckWARN_d(WARN_INTERNAL))
return;
}
if (ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_
WARN_INTERNAL
, "Attempt to free unreferenced scalar");
+ Perl_warner(aTHX_
packWARN(WARN_INTERNAL)
, "Attempt to free unreferenced scalar");
return;
}
ATOMIC_DEC_AND_TEST(refcount_is_zero, SvREFCNT(sv));
return;
}
ATOMIC_DEC_AND_TEST(refcount_is_zero, SvREFCNT(sv));
@@
-5182,7
+5201,7
@@
Perl_sv_free(pTHX_ SV *sv)
#ifdef DEBUGGING
if (SvTEMP(sv)) {
if (ckWARN_d(WARN_DEBUGGING))
#ifdef DEBUGGING
if (SvTEMP(sv)) {
if (ckWARN_d(WARN_DEBUGGING))
- Perl_warner(aTHX_
WARN_DEBUGGING
,
+ Perl_warner(aTHX_
packWARN(WARN_DEBUGGING)
,
"Attempt to free temp prematurely: SV 0x%"UVxf,
PTR2UV(sv));
return;
"Attempt to free temp prematurely: SV 0x%"UVxf,
PTR2UV(sv));
return;
@@
-5349,10
+5368,8
@@
Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
char *pv2;
STRLEN cur2;
I32 eq = 0;
char *pv2;
STRLEN cur2;
I32 eq = 0;
- char *tpv1 = Nullch;
- char *tpv2 = Nullch;
- SV* sv1recode = Nullsv;
- SV* sv2recode = Nullsv;
+ char *tpv = Nullch;
+ SV* svrecode = Nullsv;
if (!sv1) {
pv1 = "";
if (!sv1) {
pv1 = "";
@@
-5373,14
+5390,14
@@
Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
* Do not UTF8size the comparands as a side-effect. */
if (PL_encoding) {
if (SvUTF8(sv1)) {
* Do not UTF8size the comparands as a side-effect. */
if (PL_encoding) {
if (SvUTF8(sv1)) {
- sv
2
recode = newSVpvn(pv2, cur2);
- sv_recode_to_utf8(sv
2
recode, PL_encoding);
- pv2 = SvPV(sv
2
recode, cur2);
+ svrecode = newSVpvn(pv2, cur2);
+ sv_recode_to_utf8(svrecode, PL_encoding);
+ pv2 = SvPV(svrecode, cur2);
}
else {
}
else {
- sv
1
recode = newSVpvn(pv1, cur1);
- sv_recode_to_utf8(sv
1
recode, PL_encoding);
- pv
2 = SvPV(sv1
recode, cur1);
+ svrecode = newSVpvn(pv1, cur1);
+ sv_recode_to_utf8(svrecode, PL_encoding);
+ pv
1 = SvPV(sv
recode, cur1);
}
/* Now both are in UTF-8. */
if (cur1 != cur2)
}
/* Now both are in UTF-8. */
if (cur1 != cur2)
@@
-5395,7
+5412,7
@@
Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
char *pv = (char*)bytes_from_utf8((U8*)pv1,
&cur1, &is_utf8);
if (pv != pv1)
char *pv = (char*)bytes_from_utf8((U8*)pv1,
&cur1, &is_utf8);
if (pv != pv1)
- pv1 = tpv
1
= pv;
+ pv1 = tpv = pv;
}
else {
/* sv2 is the UTF-8 one,
}
else {
/* sv2 is the UTF-8 one,
@@
-5403,7
+5420,7
@@
Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
char *pv = (char *)bytes_from_utf8((U8*)pv2,
&cur2, &is_utf8);
if (pv != pv2)
char *pv = (char *)bytes_from_utf8((U8*)pv2,
&cur2, &is_utf8);
if (pv != pv2)
- pv2 = tpv
2
= pv;
+ pv2 = tpv = pv;
}
if (is_utf8) {
/* Downgrade not possible - cannot be eq */
}
if (is_utf8) {
/* Downgrade not possible - cannot be eq */
@@
-5415,15
+5432,11
@@
Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
if (cur1 == cur2)
eq = memEQ(pv1, pv2, cur1);
if (cur1 == cur2)
eq = memEQ(pv1, pv2, cur1);
- if (sv1recode)
- SvREFCNT_dec(sv1recode);
- if (sv2recode)
- SvREFCNT_dec(sv2recode);
+ if (svrecode)
+ SvREFCNT_dec(svrecode);
- if (tpv1)
- Safefree(tpv1);
- if (tpv2)
- Safefree(tpv2);
+ if (tpv)
+ Safefree(tpv);
return eq;
}
return eq;
}
@@
-5443,12
+5456,9
@@
I32
Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
{
STRLEN cur1, cur2;
Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
{
STRLEN cur1, cur2;
- char *pv1, *pv2;
+ char *pv1, *pv2
, *tpv = Nullch
;
I32 cmp;
I32 cmp;
- bool pv1tmp = FALSE;
- bool pv2tmp = FALSE;
- SV *sv1recode = Nullsv;
- SV *sv2recode = Nullsv;
+ SV *svrecode = Nullsv;
if (!sv1) {
pv1 = "";
if (!sv1) {
pv1 = "";
@@
-5457,7
+5467,7
@@
Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
else
pv1 = SvPV(sv1, cur1);
else
pv1 = SvPV(sv1, cur1);
- if (!sv2){
+ if (!sv2)
{
pv2 = "";
cur2 = 0;
}
pv2 = "";
cur2 = 0;
}
@@
-5469,24
+5479,22
@@
Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
* Do not UTF8size the comparands as a side-effect. */
if (SvUTF8(sv1)) {
if (PL_encoding) {
* Do not UTF8size the comparands as a side-effect. */
if (SvUTF8(sv1)) {
if (PL_encoding) {
- sv
2
recode = newSVpvn(pv2, cur2);
- sv_recode_to_utf8(sv
2
recode, PL_encoding);
- pv2 = SvPV(sv
2
recode, cur2);
+ svrecode = newSVpvn(pv2, cur2);
+ sv_recode_to_utf8(svrecode, PL_encoding);
+ pv2 = SvPV(svrecode, cur2);
}
else {
}
else {
- pv2 = (char*)bytes_to_utf8((U8*)pv2, &cur2);
- pv2tmp = TRUE;
+ pv2 = tpv = (char*)bytes_to_utf8((U8*)pv2, &cur2);
}
}
else {
if (PL_encoding) {
}
}
else {
if (PL_encoding) {
- sv
1
recode = newSVpvn(pv1, cur1);
- sv_recode_to_utf8(sv
1
recode, PL_encoding);
- pv1 = SvPV(sv
1
recode, cur1);
+ svrecode = newSVpvn(pv1, cur1);
+ sv_recode_to_utf8(svrecode, PL_encoding);
+ pv1 = SvPV(svrecode, cur1);
}
else {
}
else {
- pv1 = (char*)bytes_to_utf8((U8*)pv1, &cur1);
- pv1tmp = TRUE;
+ pv1 = tpv = (char*)bytes_to_utf8((U8*)pv1, &cur1);
}
}
}
}
}
}
@@
-5507,15
+5515,11
@@
Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
}
}
}
}
- if (sv1recode)
- SvREFCNT_dec(sv1recode);
- if (sv2recode)
- SvREFCNT_dec(sv2recode);
+ if (svrecode)
+ SvREFCNT_dec(svrecode);
- if (pv1tmp)
- Safefree(pv1);
- if (pv2tmp)
- Safefree(pv2);
+ if (tpv)
+ Safefree(tpv);
return cmp;
}
return cmp;
}
@@
-6535,7
+6539,7
@@
Perl_newSVsv(pTHX_ register SV *old)
return Nullsv;
if (SvTYPE(old) == SVTYPEMASK) {
if (ckWARN_d(WARN_INTERNAL))
return Nullsv;
if (SvTYPE(old) == SVTYPEMASK) {
if (ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_
WARN_INTERNAL
, "semi-panic: attempt to dup freed string");
+ Perl_warner(aTHX_
packWARN(WARN_INTERNAL)
, "semi-panic: attempt to dup freed string");
return Nullsv;
}
new_SV(sv);
return Nullsv;
}
new_SV(sv);
@@
-6686,8
+6690,8
@@
possible to set C<*st> and C<*gvp> to the stash and GV associated with it.
CV *
Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
{
CV *
Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
{
- GV *gv;
- CV *cv;
+ GV *gv
= Nullgv
;
+ CV *cv
= Nullcv
;
STRLEN n_a;
if (!sv)
STRLEN n_a;
if (!sv)
@@
-6851,12
+6855,16
@@
Perl_sv_nv(pTHX_ register SV *sv)
/*
=for apidoc sv_pv
/*
=for apidoc sv_pv
-A private implementation of the C<SvPV_nolen> macro for compilers which can't
-cope with complex macro expressions. Always use the macro instead.
+Use the C<SvPV_nolen> macro instead
=cut
*/
=cut
*/
+/* sv_pv() is now a macro using SvPV_nolen();
+ * this function provided for binary compatibility only
+ */
+
+
char *
Perl_sv_pv(pTHX_ SV *sv)
{
char *
Perl_sv_pv(pTHX_ SV *sv)
{
@@
-6887,8
+6895,6
@@
Perl_sv_pvn(pTHX_ SV *sv, STRLEN *lp)
return sv_2pv(sv, lp);
}
return sv_2pv(sv, lp);
}
-/* For -DCRIPPLED_CC only. See also C<sv_2pv_flags()>.
- */
char *
Perl_sv_pvn_nomg(pTHX_ register SV *sv, STRLEN *lp)
char *
Perl_sv_pvn_nomg(pTHX_ register SV *sv, STRLEN *lp)
@@
-6910,6
+6916,10
@@
can't cope with complex macro expressions. Always use the macro instead.
=cut
*/
=cut
*/
+/* sv_pvn_force() is now a macro using Perl_sv_pvn_force_flags();
+ * this function provided for binary compatibility only
+ */
+
char *
Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp)
{
char *
Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp)
{
@@
-6932,7
+6942,7
@@
C<SvPV_force> and C<SvPV_force_nomg>
char *
Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags)
{
char *
Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags)
{
- char *s;
+ char *s
= NULL
;
if (SvTHINKFIRST(sv) && !SvROK(sv))
sv_force_normal(sv);
if (SvTHINKFIRST(sv) && !SvROK(sv))
sv_force_normal(sv);
@@
-6971,13
+6981,16
@@
Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags)
/*
=for apidoc sv_pvbyte
/*
=for apidoc sv_pvbyte
-A private implementation of the C<SvPVbyte_nolen> macro for compilers
-which can't cope with complex macro expressions. Always use the macro
-instead.
+Use C<SvPVbyte_nolen> instead.
=cut
*/
=cut
*/
+/* sv_pvbyte () is now a macro using Perl_sv_2pv_flags();
+ * this function provided for binary compatibility only
+ */
+
+
char *
Perl_sv_pvbyte(pTHX_ SV *sv)
{
char *
Perl_sv_pvbyte(pTHX_ SV *sv)
{
@@
-7022,12
+7035,14
@@
Perl_sv_pvbyten_force(pTHX_ SV *sv, STRLEN *lp)
/*
=for apidoc sv_pvutf8
/*
=for apidoc sv_pvutf8
-A private implementation of the C<SvPVutf8_nolen> macro for compilers
-which can't cope with complex macro expressions. Always use the macro
-instead.
+Use the C<SvPVutf8_nolen> macro instead
=cut
*/
=cut
*/
+/* sv_pvutf8 () is now a macro using Perl_sv_2pv_flags();
+ * this function provided for binary compatibility only
+ */
+
char *
Perl_sv_pvutf8(pTHX_ SV *sv)
char *
Perl_sv_pvutf8(pTHX_ SV *sv)
@@
-7841,7
+7856,7
@@
Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
SV *vecsv;
U8 *vecstr = Null(U8*);
STRLEN veclen = 0;
SV *vecsv;
U8 *vecstr = Null(U8*);
STRLEN veclen = 0;
- char c;
+ char c
= 0
;
int i;
unsigned base = 0;
IV iv = 0;
int i;
unsigned base = 0;
IV iv = 0;
@@
-8298,7
+8313,7
@@
Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
if (n >= 2 && s[n-2] == '1' && s[n-1] == '9'
&& (n == 2 || !isDIGIT(s[n-3])))
{
if (n >= 2 && s[n-2] == '1' && s[n-1] == '9'
&& (n == 2 || !isDIGIT(s[n-3])))
{
- Perl_warner(aTHX_
WARN_Y2K
,
+ Perl_warner(aTHX_
packWARN(WARN_Y2K)
,
"Possible Y2K bug: %%%c %s",
c, "format string following '19'");
}
"Possible Y2K bug: %%%c %s",
c, "format string following '19'");
}
@@
-8435,7
+8450,7
@@
Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
(UV)c & 0xFF);
} else
sv_catpv(msg, "end of string");
(UV)c & 0xFF);
} else
sv_catpv(msg, "end of string");
- Perl_warner(aTHX_
WARN_PRINTF
, "%"SVf, msg); /* yes, this is reentrant */
+ Perl_warner(aTHX_
packWARN(WARN_PRINTF)
, "%"SVf, msg); /* yes, this is reentrant */
}
/* output mangled stuff ... */
}
/* output mangled stuff ... */
@@
-8596,6
+8611,7
@@
Perl_re_dup(pTHX_ REGEXP *r, CLONE_PARAMS *param)
s->min_offset = r->substrs->data[i].min_offset;
s->max_offset = r->substrs->data[i].max_offset;
s->substr = sv_dup_inc(r->substrs->data[i].substr, param);
s->min_offset = r->substrs->data[i].min_offset;
s->max_offset = r->substrs->data[i].max_offset;
s->substr = sv_dup_inc(r->substrs->data[i].substr, param);
+ s->utf8_substr = sv_dup_inc(r->substrs->data[i].utf8_substr, param);
}
ret->regstclass = NULL;
}
ret->regstclass = NULL;
@@
-9882,8
+9898,7
@@
perl_clone_using(PerlInterpreter *proto_perl, UV flags,
PL_debug = proto_perl->Idebug;
#ifdef USE_REENTRANT_API
PL_debug = proto_perl->Idebug;
#ifdef USE_REENTRANT_API
- New(31337, PL_reentrant_buffer,1, REBUF);
- New(31337, PL_reentrant_buffer->tmbuff,1, struct tm);
+ Perl_reentrant_init(aTHX);
#endif
/* create SV map for pointer relocation */
#endif
/* create SV map for pointer relocation */
@@
-9993,6
+10008,10
@@
perl_clone_using(PerlInterpreter *proto_perl, UV flags,
#endif
PL_encoding = sv_dup(proto_perl->Iencoding, param);
#endif
PL_encoding = sv_dup(proto_perl->Iencoding, param);
+ sv_setpvn(PERL_DEBUG_PAD(0), "", 0); /* For regex debugging. */
+ sv_setpvn(PERL_DEBUG_PAD(1), "", 0); /* ext/re needs these */
+ sv_setpvn(PERL_DEBUG_PAD(2), "", 0); /* even without DEBUGGING. */
+
/* Clone the regex array */
PL_regex_padav = newAV();
{
/* Clone the regex array */
PL_regex_padav = newAV();
{