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
(??{...}) didn't always restore PL_reg_re.
[perl5.git]
/
universal.c
diff --git
a/universal.c
b/universal.c
index
fe76f81
..
8802cb2
100644
(file)
--- a/
universal.c
+++ b/
universal.c
@@
-1,7
+1,7
@@
/* universal.c
*
* Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
/* universal.c
*
* Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- * 2005, by Larry Wall and others
+ * 2005,
2006,
by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
@@
-31,10
+31,11
@@
* The main guts of traverse_isa was actually copied from gv_fetchmeth
*/
* The main guts of traverse_isa was actually copied from gv_fetchmeth
*/
-STATIC
SV *
+STATIC
bool
S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
int len, int level)
{
S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
int len, int level)
{
+ dVAR;
AV* av;
GV* gv;
GV** gvp;
AV* av;
GV* gv;
GV** gvp;
@@
-45,21
+46,21
@@
S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
/* A stash/class can go by many names (ie. User == main::User), so
we compare the stash itself just in case */
if (name_stash && (stash == name_stash))
/* A stash/class can go by many names (ie. User == main::User), so
we compare the stash itself just in case */
if (name_stash && (stash == name_stash))
- return
&PL_sv_yes
;
+ return
TRUE
;
hvname = HvNAME_get(stash);
if (strEQ(hvname, name))
hvname = HvNAME_get(stash);
if (strEQ(hvname, name))
- return
&PL_sv_yes
;
+ return
TRUE
;
if (strEQ(name, "UNIVERSAL"))
if (strEQ(name, "UNIVERSAL"))
- return
&PL_sv_yes
;
+ return
TRUE
;
if (level > 100)
Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
hvname);
if (level > 100)
Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
hvname);
- gvp = (GV**)hv_fetch
(stash, "::ISA::CACHE::", 14
, FALSE);
+ gvp = (GV**)hv_fetch
s(stash, "::ISA::CACHE::"
, FALSE);
if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (subgen = GvSV(gv))
&& (hv = GvHV(gv)))
if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (subgen = GvSV(gv))
&& (hv = GvHV(gv)))
@@
-70,7
+71,7
@@
S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
if (svp && (sv = *svp) != (SV*)&PL_sv_undef) {
DEBUG_o( Perl_deb(aTHX_ "Using cached ISA %s for package %s\n",
name, hvname) );
if (svp && (sv = *svp) != (SV*)&PL_sv_undef) {
DEBUG_o( Perl_deb(aTHX_ "Using cached ISA %s for package %s\n",
name, hvname) );
- return
sv
;
+ return
(sv == &PL_sv_yes)
;
}
}
else {
}
}
else {
@@
-81,11
+82,11
@@
S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
}
}
}
}
- gvp = (GV**)hv_fetch
(stash,"ISA",3,
FALSE);
+ gvp = (GV**)hv_fetch
s(stash, "ISA",
FALSE);
if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
if (!hv || !subgen) {
if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
if (!hv || !subgen) {
- gvp = (GV**)hv_fetch
(stash, "::ISA::CACHE::", 14
, TRUE);
+ gvp = (GV**)hv_fetch
s(stash, "::ISA::CACHE::"
, TRUE);
gv = *gvp;
gv = *gvp;
@@
-113,16
+114,15
@@
S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
sv, hvname);
continue;
}
sv, hvname);
continue;
}
- if (&PL_sv_yes == isa_lookup(basestash, name, name_stash,
- len, level + 1)) {
+ if (isa_lookup(basestash, name, name_stash, len, level + 1)) {
(void)hv_store(hv,name,len,&PL_sv_yes,0);
(void)hv_store(hv,name,len,&PL_sv_yes,0);
- return
&PL_sv_yes
;
+ return
TRUE
;
}
}
(void)hv_store(hv,name,len,&PL_sv_no,0);
}
}
}
}
(void)hv_store(hv,name,len,&PL_sv_no,0);
}
}
- return
&PL_sv_no
;
+ return
FALSE
;
}
/*
}
/*
@@
-140,6
+140,7
@@
for class names as well as for objects.
bool
Perl_sv_derived_from(pTHX_ SV *sv, const char *name)
{
bool
Perl_sv_derived_from(pTHX_ SV *sv, const char *name)
{
+ dVAR;
HV *stash;
SvGETMAGIC(sv);
HV *stash;
SvGETMAGIC(sv);
@@
-158,7
+159,7
@@
Perl_sv_derived_from(pTHX_ SV *sv, const char *name)
if (stash) {
HV * const name_stash = gv_stashpv(name, FALSE);
if (stash) {
HV * const name_stash = gv_stashpv(name, FALSE);
- return isa_lookup(stash, name, name_stash, strlen(name), 0)
== &PL_sv_yes
;
+ return isa_lookup(stash, name, name_stash, strlen(name), 0);
}
else
return FALSE;
}
else
return FALSE;
@@
-204,7
+205,8
@@
XS(XS_Internals_inc_sub_generation);
void
Perl_boot_core_UNIVERSAL(pTHX)
{
void
Perl_boot_core_UNIVERSAL(pTHX)
{
- const char file[] = __FILE__;
+ dVAR;
+ static const char file[] = __FILE__;
newXS("UNIVERSAL::isa", XS_UNIVERSAL_isa, file);
newXS("UNIVERSAL::can", XS_UNIVERSAL_can, file);
newXS("UNIVERSAL::isa", XS_UNIVERSAL_isa, file);
newXS("UNIVERSAL::can", XS_UNIVERSAL_can, file);
@@
-255,6
+257,7
@@
Perl_boot_core_UNIVERSAL(pTHX)
XS(XS_UNIVERSAL_isa)
{
XS(XS_UNIVERSAL_isa)
{
+ dVAR;
dXSARGS;
if (items != 2)
dXSARGS;
if (items != 2)
@@
-278,6
+281,7
@@
XS(XS_UNIVERSAL_isa)
XS(XS_UNIVERSAL_can)
{
XS(XS_UNIVERSAL_can)
{
+ dVAR;
dXSARGS;
SV *sv;
const char *name;
dXSARGS;
SV *sv;
const char *name;
@@
-319,6
+323,7
@@
XS(XS_UNIVERSAL_can)
XS(XS_UNIVERSAL_VERSION)
{
XS(XS_UNIVERSAL_VERSION)
{
+ dVAR;
dXSARGS;
HV *pkg;
GV **gvp;
dXSARGS;
HV *pkg;
GV **gvp;
@@
-336,7
+341,7
@@
XS(XS_UNIVERSAL_VERSION)
pkg = gv_stashsv(ST(0), FALSE);
}
pkg = gv_stashsv(ST(0), FALSE);
}
- gvp = pkg ? (GV**)hv_fetch
(pkg,"VERSION",7,FALSE) : Null(GV**)
;
+ gvp = pkg ? (GV**)hv_fetch
s(pkg, "VERSION", FALSE) : NULL
;
if (gvp && isGV(gv = *gvp) && (sv = GvSV(gv)) && SvOK(sv)) {
SV * const nsv = sv_newmortal();
if (gvp && isGV(gv = *gvp) && (sv = GvSV(gv)) && SvOK(sv)) {
SV * const nsv = sv_newmortal();
@@
-392,6
+397,7
@@
XS(XS_UNIVERSAL_VERSION)
XS(XS_version_new)
{
XS(XS_version_new)
{
+ dVAR;
dXSARGS;
if (items > 3)
Perl_croak(aTHX_ "Usage: version::new(class, version)");
dXSARGS;
if (items > 3)
Perl_croak(aTHX_ "Usage: version::new(class, version)");
@@
-433,6
+439,7
@@
XS(XS_version_new)
XS(XS_version_stringify)
{
XS(XS_version_stringify)
{
+ dVAR;
dXSARGS;
if (items < 1)
Perl_croak(aTHX_ "Usage: version::stringify(lobj, ...)");
dXSARGS;
if (items < 1)
Perl_croak(aTHX_ "Usage: version::stringify(lobj, ...)");
@@
-455,6
+462,7
@@
XS(XS_version_stringify)
XS(XS_version_numify)
{
XS(XS_version_numify)
{
+ dVAR;
dXSARGS;
if (items < 1)
Perl_croak(aTHX_ "Usage: version::numify(lobj, ...)");
dXSARGS;
if (items < 1)
Perl_croak(aTHX_ "Usage: version::numify(lobj, ...)");
@@
-477,6
+485,7
@@
XS(XS_version_numify)
XS(XS_version_normal)
{
XS(XS_version_normal)
{
+ dVAR;
dXSARGS;
if (items < 1)
Perl_croak(aTHX_ "Usage: version::normal(lobj, ...)");
dXSARGS;
if (items < 1)
Perl_croak(aTHX_ "Usage: version::normal(lobj, ...)");
@@
-499,6
+508,7
@@
XS(XS_version_normal)
XS(XS_version_vcmp)
{
XS(XS_version_vcmp)
{
+ dVAR;
dXSARGS;
if (items < 1)
Perl_croak(aTHX_ "Usage: version::vcmp(lobj, ...)");
dXSARGS;
if (items < 1)
Perl_croak(aTHX_ "Usage: version::vcmp(lobj, ...)");
@@
-543,10
+553,11
@@
XS(XS_version_vcmp)
XS(XS_version_boolean)
{
XS(XS_version_boolean)
{
- dXSARGS;
- if (items < 1)
- Perl_croak(aTHX_ "Usage: version::boolean(lobj, ...)");
- SP -= items;
+ dVAR;
+ dXSARGS;
+ if (items < 1)
+ Perl_croak(aTHX_ "Usage: version::boolean(lobj, ...)");
+ SP -= items;
if (sv_derived_from(ST(0), "version")) {
SV * const lobj = SvRV(ST(0));
SV * const rs = newSViv( vcmp(lobj,new_version(newSVpvs("0"))) );
if (sv_derived_from(ST(0), "version")) {
SV * const lobj = SvRV(ST(0));
SV * const rs = newSViv( vcmp(lobj,new_version(newSVpvs("0"))) );
@@
-560,6
+571,7
@@
XS(XS_version_boolean)
XS(XS_version_noop)
{
XS(XS_version_noop)
{
+ dVAR;
dXSARGS;
if (items < 1)
Perl_croak(aTHX_ "Usage: version::noop(lobj, ...)");
dXSARGS;
if (items < 1)
Perl_croak(aTHX_ "Usage: version::noop(lobj, ...)");
@@
-574,6
+586,7
@@
XS(XS_version_noop)
XS(XS_version_is_alpha)
{
XS(XS_version_is_alpha)
{
+ dVAR;
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: version::is_alpha(lobj)");
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: version::is_alpha(lobj)");
@@
-593,6
+606,7
@@
XS(XS_version_is_alpha)
XS(XS_version_qv)
{
XS(XS_version_qv)
{
+ dVAR;
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: version::qv(ver)");
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: version::qv(ver)");
@@
-629,6
+643,7
@@
XS(XS_version_qv)
XS(XS_utf8_is_utf8)
{
XS(XS_utf8_is_utf8)
{
+ dVAR;
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::is_utf8(sv)");
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::is_utf8(sv)");
@@
-644,6
+659,7
@@
XS(XS_utf8_is_utf8)
XS(XS_utf8_valid)
{
XS(XS_utf8_valid)
{
+ dVAR;
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::valid(sv)");
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::valid(sv)");
@@
-661,6
+677,7
@@
XS(XS_utf8_valid)
XS(XS_utf8_encode)
{
XS(XS_utf8_encode)
{
+ dVAR;
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::encode(sv)");
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::encode(sv)");
@@
-670,6
+687,7
@@
XS(XS_utf8_encode)
XS(XS_utf8_decode)
{
XS(XS_utf8_decode)
{
+ dVAR;
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::decode(sv)");
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::decode(sv)");
@@
-684,6
+702,7
@@
XS(XS_utf8_decode)
XS(XS_utf8_upgrade)
{
XS(XS_utf8_upgrade)
{
+ dVAR;
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::upgrade(sv)");
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::upgrade(sv)");
@@
-700,6
+719,7
@@
XS(XS_utf8_upgrade)
XS(XS_utf8_downgrade)
{
XS(XS_utf8_downgrade)
{
+ dVAR;
dXSARGS;
if (items < 1 || items > 2)
Perl_croak(aTHX_ "Usage: utf8::downgrade(sv, failok=0)");
dXSARGS;
if (items < 1 || items > 2)
Perl_croak(aTHX_ "Usage: utf8::downgrade(sv, failok=0)");
@@
-716,6
+736,7
@@
XS(XS_utf8_downgrade)
XS(XS_utf8_native_to_unicode)
{
XS(XS_utf8_native_to_unicode)
{
+ dVAR;
dXSARGS;
const UV uv = SvUV(ST(0));
dXSARGS;
const UV uv = SvUV(ST(0));
@@
-728,6
+749,7
@@
XS(XS_utf8_native_to_unicode)
XS(XS_utf8_unicode_to_native)
{
XS(XS_utf8_unicode_to_native)
{
+ dVAR;
dXSARGS;
const UV uv = SvUV(ST(0));
dXSARGS;
const UV uv = SvUV(ST(0));
@@
-740,6
+762,7
@@
XS(XS_utf8_unicode_to_native)
XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */
{
XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */
{
+ dVAR;
dXSARGS;
SV * const sv = SvRV(ST(0));
dXSARGS;
SV * const sv = SvRV(ST(0));
@@
-765,6
+788,7
@@
XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */
XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */
{
XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */
{
+ dVAR;
dXSARGS;
SV * const sv = SvRV(ST(0));
dXSARGS;
SV * const sv = SvRV(ST(0));
@@
-780,6
+804,7
@@
XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */
XS(XS_Internals_hv_clear_placehold)
{
XS(XS_Internals_hv_clear_placehold)
{
+ dVAR;
dXSARGS;
if (items != 1)
dXSARGS;
if (items != 1)
@@
-793,11
+818,13
@@
XS(XS_Internals_hv_clear_placehold)
XS(XS_Regexp_DESTROY)
{
XS(XS_Regexp_DESTROY)
{
+ PERL_UNUSED_CONTEXT;
PERL_UNUSED_ARG(cv);
}
XS(XS_PerlIO_get_layers)
{
PERL_UNUSED_ARG(cv);
}
XS(XS_PerlIO_get_layers)
{
+ dVAR;
dXSARGS;
if (items < 1 || items % 2 == 0)
Perl_croak(aTHX_ "Usage: PerlIO_get_layers(filehandle[,args])");
dXSARGS;
if (items < 1 || items % 2 == 0)
Perl_croak(aTHX_ "Usage: PerlIO_get_layers(filehandle[,args])");
@@
-919,6
+946,7
@@
XS(XS_PerlIO_get_layers)
XS(XS_Internals_hash_seed)
{
XS(XS_Internals_hash_seed)
{
+ dVAR;
/* Using dXSARGS would also have dITEM and dSP,
* which define 2 unused local variables. */
dAXMARK;
/* Using dXSARGS would also have dITEM and dSP,
* which define 2 unused local variables. */
dAXMARK;
@@
-929,6
+957,7
@@
XS(XS_Internals_hash_seed)
XS(XS_Internals_rehash_seed)
{
XS(XS_Internals_rehash_seed)
{
+ dVAR;
/* Using dXSARGS would also have dITEM and dSP,
* which define 2 unused local variables. */
dAXMARK;
/* Using dXSARGS would also have dITEM and dSP,
* which define 2 unused local variables. */
dAXMARK;
@@
-939,6
+968,7
@@
XS(XS_Internals_rehash_seed)
XS(XS_Internals_HvREHASH) /* Subject to change */
{
XS(XS_Internals_HvREHASH) /* Subject to change */
{
+ dVAR;
dXSARGS;
if (SvROK(ST(0))) {
const HV * const hv = (HV *) SvRV(ST(0));
dXSARGS;
if (SvROK(ST(0))) {
const HV * const hv = (HV *) SvRV(ST(0));
@@
-954,6
+984,7
@@
XS(XS_Internals_HvREHASH) /* Subject to change */
XS(XS_Internals_inc_sub_generation)
{
XS(XS_Internals_inc_sub_generation)
{
+ dVAR;
/* Using dXSARGS would also have dITEM and dSP,
* which define 2 unused local variables. */
dAXMARK;
/* Using dXSARGS would also have dITEM and dSP,
* which define 2 unused local variables. */
dAXMARK;