Change 29915 by [EMAIL PROTECTED] on 2007/01/22 15:49:59
Integrate:
[ 27533]
sv_find() returning false, followed by sv_magic() to add the magic,
followed immediately by sv_find() to find it, is somewhat wasteful.
So use sv_magicext(). (All cases are also correct w.r.t. SvREADONLY())
[ 27542]
Subject: [PATCH] Change the semantics of S_isa_lookup
From: Andy Lester <[EMAIL PROTECTED]>
Date: Sat, 18 Mar 2006 00:28:45 -0600
Message-ID: <[EMAIL PROTECTED]>
[ 27548]
If the scalar has just been upgraded to SVt_RV, there's no way SvPVX
can be non-NULL, so no need to check.
Affected files ...
... //depot/maint-5.8/perl/embed.fnc#175 integrate
... //depot/maint-5.8/perl/mg.c#127 integrate
... //depot/maint-5.8/perl/pp.c#115 integrate
... //depot/maint-5.8/perl/pp_ctl.c#147 integrate
... //depot/maint-5.8/perl/pp_hot.c#115 integrate
... //depot/maint-5.8/perl/proto.h#164 integrate
... //depot/maint-5.8/perl/regexec.c#67 integrate
... //depot/maint-5.8/perl/sv.c#300 integrate
... //depot/maint-5.8/perl/universal.c#57 integrate
Differences ...
==== //depot/maint-5.8/perl/embed.fnc#175 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#174~29913~ 2007-01-22 06:45:23.000000000 -0800
+++ perl/embed.fnc 2007-01-22 07:49:59.000000000 -0800
@@ -1378,7 +1378,7 @@
#endif
#if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT)
-s |SV*|isa_lookup |NULLOK HV *stash|NN const char *name|NULLOK HV
*name_stash|int len|int level
+s |bool|isa_lookup |NULLOK HV *stash|NN const char *name|NULLOK HV
*name_stash|int len|int level
#endif
#if defined(PERL_IN_LOCALE_C) || defined(PERL_DECL_PROT)
==== //depot/maint-5.8/perl/mg.c#127 (text) ====
Index: perl/mg.c
--- perl/mg.c#126~29912~ 2007-01-21 15:33:27.000000000 -0800
+++ perl/mg.c 2007-01-22 07:49:59.000000000 -0800
@@ -1793,8 +1793,12 @@
if (!mg) {
if (!SvOK(sv))
return 0;
- sv_magic(lsv, NULL, PERL_MAGIC_regex_global, NULL, 0);
- mg = mg_find(lsv, PERL_MAGIC_regex_global);
+#ifdef PERL_OLD_COPY_ON_WRITE
+ if (SvIsCOW(lsv))
+ sv_force_normal_flags(lsv, 0);
+#endif
+ mg = sv_magicext(lsv, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob,
+ NULL, 0);
}
else if (!SvOK(sv)) {
mg->mg_len = -1;
==== //depot/maint-5.8/perl/pp.c#115 (text) ====
Index: perl/pp.c
--- perl/pp.c#114~29903~ 2007-01-20 16:16:12.000000000 -0800
+++ perl/pp.c 2007-01-22 07:49:59.000000000 -0800
@@ -171,7 +171,7 @@
}
if (SvTYPE(sv) < SVt_RV)
sv_upgrade(sv, SVt_RV);
- if (SvPVX_const(sv)) {
+ else if (SvPVX_const(sv)) {
SvPV_free(sv);
SvLEN_set(sv, 0);
SvCUR_set(sv, 0);
==== //depot/maint-5.8/perl/pp_ctl.c#147 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#146~29908~ 2007-01-21 13:58:40.000000000 -0800
+++ perl/pp_ctl.c 2007-01-22 07:49:59.000000000 -0800
@@ -246,8 +246,12 @@
if (SvTYPE(sv) < SVt_PVMG)
(void)SvUPGRADE(sv, SVt_PVMG);
if (!(mg = mg_find(sv, PERL_MAGIC_regex_global))) {
- sv_magic(sv, NULL, PERL_MAGIC_regex_global, NULL, 0);
- mg = mg_find(sv, PERL_MAGIC_regex_global);
+#ifdef PERL_OLD_COPY_ON_WRITE
+ if (SvIsCOW(lsv))
+ sv_force_normal_flags(sv, 0);
+#endif
+ mg = sv_magicext(sv, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob,
+ NULL, 0);
}
i = m - orig;
if (DO_UTF8(sv))
==== //depot/maint-5.8/perl/pp_hot.c#115 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#114~29913~ 2007-01-22 06:45:23.000000000 -0800
+++ perl/pp_hot.c 2007-01-22 07:49:59.000000000 -0800
@@ -1417,8 +1417,12 @@
if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
mg = mg_find(TARG, PERL_MAGIC_regex_global);
if (!mg) {
- sv_magic(TARG, NULL, PERL_MAGIC_regex_global, NULL, 0);
- mg = mg_find(TARG, PERL_MAGIC_regex_global);
+#ifdef PERL_OLD_COPY_ON_WRITE
+ if (SvIsCOW(TARG))
+ sv_force_normal_flags(TARG, 0);
+#endif
+ mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global,
+ &PL_vtbl_mglob, NULL, 0);
}
if (rx->startp[0] != -1) {
mg->mg_len = rx->endp[0];
@@ -1447,8 +1451,12 @@
else
mg = NULL;
if (!mg) {
- sv_magic(TARG, NULL, PERL_MAGIC_regex_global, NULL, 0);
- mg = mg_find(TARG, PERL_MAGIC_regex_global);
+#ifdef PERL_OLD_COPY_ON_WRITE
+ if (SvIsCOW(TARG))
+ sv_force_normal_flags(TARG, 0);
+#endif
+ mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global,
+ &PL_vtbl_mglob, NULL, 0);
}
if (rx->startp[0] != -1) {
mg->mg_len = rx->endp[0];
==== //depot/maint-5.8/perl/proto.h#164 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#163~29913~ 2007-01-22 06:45:23.000000000 -0800
+++ perl/proto.h 2007-01-22 07:49:59.000000000 -0800
@@ -2006,7 +2006,7 @@
#endif
#if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT)
-STATIC SV* S_isa_lookup(pTHX_ HV *stash, const char *name, HV *name_stash,
int len, int level);
+STATIC bool S_isa_lookup(pTHX_ HV *stash, const char *name, HV *name_stash,
int len, int level);
#endif
#if defined(PERL_IN_LOCALE_C) || defined(PERL_DECL_PROT)
==== //depot/maint-5.8/perl/regexec.c#67 (text) ====
Index: perl/regexec.c
--- perl/regexec.c#66~29908~ 2007-01-21 13:58:40.000000000 -0800
+++ perl/regexec.c 2007-01-22 07:49:59.000000000 -0800
@@ -2107,9 +2107,12 @@
if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv)
&& (mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global)))) {
/* prepare for quick setting of pos */
- sv_magic(PL_reg_sv, (SV*)0,
- PERL_MAGIC_regex_global, NULL, 0);
- mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global);
+#ifdef PERL_OLD_COPY_ON_WRITE
+ if (SvIsCOW(sv))
+ sv_force_normal_flags(sv, 0);
+#endif
+ mg = sv_magicext(PL_reg_sv, (SV*)0, PERL_MAGIC_regex_global,
+ &PL_vtbl_mglob, NULL, 0);
mg->mg_len = -1;
}
PL_reg_magic = mg;
==== //depot/maint-5.8/perl/sv.c#300 (text) ====
Index: perl/sv.c
--- perl/sv.c#299~29912~ 2007-01-21 15:33:27.000000000 -0800
+++ perl/sv.c 2007-01-22 07:49:59.000000000 -0800
@@ -5593,8 +5593,12 @@
return xf + sizeof(PL_collation_ix);
}
if (! mg) {
- sv_magic(sv, 0, PERL_MAGIC_collxfrm, 0, 0);
- mg = mg_find(sv, PERL_MAGIC_collxfrm);
+#ifdef PERL_OLD_COPY_ON_WRITE
+ if (SvIsCOW(sv))
+ sv_force_normal_flags(sv, 0);
+#endif
+ mg = sv_magicext(sv, 0, PERL_MAGIC_collxfrm, &PL_vtbl_collxfrm,
+ 0, 0);
assert(mg);
}
mg->mg_ptr = xf;
==== //depot/maint-5.8/perl/universal.c#57 (text) ====
Index: perl/universal.c
--- perl/universal.c#56~29897~ 2007-01-20 10:14:46.000000000 -0800
+++ perl/universal.c 2007-01-22 07:49:59.000000000 -0800
@@ -31,7 +31,7 @@
* 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)
{
@@ -45,15 +45,15 @@
/* 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))
- return &PL_sv_yes;
+ return TRUE;
if (strEQ(name, "UNIVERSAL"))
- return &PL_sv_yes;
+ return TRUE;
if (level > 100)
Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
@@ -70,7 +70,7 @@
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 {
@@ -113,16 +113,15 @@
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);
- return &PL_sv_yes;
+ return TRUE;
}
}
(void)hv_store(hv,name,len,&PL_sv_no,0);
}
}
- return &PL_sv_no;
+ return FALSE;
}
/*
@@ -158,7 +157,7 @@
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;
End of Patch.
