Change 28157 by nicholas@nicholas-saigo on 2006/05/11 10:03:53
Integrate:
[ 23763]
Add TD tests for UTF8 encoded soft references
[ 23766]
Stage 1 of utf8 support for soft references.
Change gv_fetchpv to take a UTF8 flag, as gv_fetchpvn_flags
Add gv_fetchsv to look up a GV by SV rather than a char * pointer
Provide a backwards compatability gv_fetchpv
Migrate from gv_fetchpv to gv_fetchsv where the caller was grabbing
the pointer from an SV
All tests still pass.
[ 23770]
Pull the am-I-utf8-or-not logic into one place (S_newSV_maybe_utf8)
as I think that it will be needed for utf8 soft references.
[ 26415]
gv_fetchpv, gv_fetchpvn and gv_fetchsv take a bitmask of flags, rather
than a simple boolean, so passing FALSE or TRUE is bogus.
[ 26434]
The lref argument of sv_2cv is actually passed onwards to gv_fetchsv,
so it is a bitmap of flag bits rather than simple TRUE/FALSE.
[ 27028]
Make Perl_gv_fetchpvn_flags actually heed the passed in length.
This means that \0 bytes in symbolic references now work.
[ 27044]
1 NUL termination assumption remains in Perl_gv_fetchpvn_flags
[ 27046]
doubleplusoops. Apart from the documented NUL termination assumption.
Now removed.
[ 27049]
And another assumption.
Affected files
//depot/maint-5.8/perl/doio.c#73 integrate
//depot/maint-5.8/perl/embed.fnc#148 integrate
//depot/maint-5.8/perl/embed.h#112 integrate
//#46 integrate
//depot/maint-5.8/perl/gv.c#69 integrate
//depot/maint-5.8/perl/gv.h#12 integrate
//depot/maint-5.8/perl/mg.c#112 integrate
//depot/maint-5.8/perl/op.c#133 integrate
//depot/maint-5.8/perl/perl.c#165 integrate
//depot/maint-5.8/perl/perl.h#118 integrate
//depot/maint-5.8/perl/pp.c#96 integrate
//depot/maint-5.8/perl/pp_hot.c#99 integrate
//depot/maint-5.8/perl/pp_sys.c#106 edit
//depot/maint-5.8/perl/proto.h#137 integrate
//depot/maint-5.8/perl/regcomp.c#68 integrate
//depot/maint-5.8/perl/sv.c#252 integrate
//depot/maint-5.8/perl/sv.h#59 integrate
//#8 integrate
//depot/maint-5.8/perl/toke.c#112 integrate
//#46 integrate
Differences
//depot/maint-5.8/perl/doio.c#73 (text)
Index: perl/doio.c
perl/doio.c#72~28129~2006-05-08 13:15:44.000000000 -0700
perl/doio.c2006-05-11 03:03:53.000000000 -0700
@@ -335,7 +335,8 @@
}
else {
GV *thatgv;
- thatgv = gv_fetchpv(type,FALSE,SVt_PVI);
+ thatgv = gv_fetchpvn_flags(type, tend - type,
+ 0, SVt_PVI);
thatio = GvI(thatgv);
}
if (!thatio) {
//depot/maint-5.8/perl/embed.fnc#148 (text)
Index: perl/embed.fnc
perl/embed.fnc#147~28154~2006-05-10 11:31:34.000000000 -0700
perl/embed.fnc2006-05-11 03:03:53.000000000 -0700
@@ -1601,6 +1601,10 @@
px|void|my_clearenv
+Ap|GV*|gv_fetchpvn_flags|const char* name|STRLEN len|I32 flags|I32 sv_type
+Ap|GV*|gv_fetchsv|SV *name|I32 flags|I32 sv_type
+dp|bool|is_gv_magical_sv|SV *name|U32 flags
+
END_EXTERN_C
/*
* ex: set ts=8 sts=4 sw=4 noet:
//depot/maint-5.8/perl/embed.h#112 (text+w)
Index: perl/embed.h
perl/embed.h#111~28154~2006-05-10 11:31:34.000000000 -0700
perl/embed.h2006-05-11 03:03:53.000000000 -0700
@@ -1641,6 +1641,11 @@
#ifdef PERL_CRE
#define my_swabnPerl_my_swabn
#endif
+#define gv_fetchpvn_flagsPerl_gv_fetchpvn_flags
+#define gv_fetchsvPerl_gv_fetchsv
+#ifdef PERL_CRE
+#define is_gv_magical_svPerl_is_gv_magical_sv
+#endif
#if defined(PERL_INP_C) || defined(PERL_DECL_PRT)
#define ck_anoncodePerl_ck_anoncode
#define ck_bitopPerl_ck_bitop
@@ -3675,6 +3680,11 @@
#ifdef PERL_CRE
#define my_swabnPerl_my_swabn
#endif
+#define gv_fetchpvn_flags(a,b,c,d)Perl_gv_fetchpvn_flags(aTHX_ a,b,c,d)
+#define gv_fetchsv(a,b,c)Perl_gv_fetchsv(aTHX_ a,b,c)
+#ifdef PERL_CRE
+#define is_gv_magical_sv(a,b)Perl_is_gv_magical_sv(aTHX_ a,b)
+#endif
#if defined(PERL_INP_C) || defined(PERL_DECL_PRT)
#define ck_anoncode(a)Perl_ck_anoncode(aTHX_ a)
#define ck_bitop(a)Perl_ck_bitop(aTHX_ a)
//#46 (text+w)
Index: perl/global.sym
perl/global.sym#45~28115~2006-05-06 17:03:20.000000000 -0700
perl/global.sym2006-05-11 03:03:53.000000000 -0700
@@ -677,6 +677,8 @@
Perl_PerlI
Perl_hv_clear_placeholders
Perl_hv_scalar
+Perl_gv_fetchpvn_flags
+Perl_gv_fetchsv
Perl_op_refcnt_lock
Perl_op_refcnt_unlock
Perl_savesvpv
//depot/maint-5.8/perl/gv.c#69 (text)
Index: perl/gv.c
perl/gv.c#68~28129~2006-05-08 13:15:44.000000000 -0700
perl/gv.c2006-05-11 03:03:53.000000000 -0700
@@ -687,28 +687,48 @@
GV *
-Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
+Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) {
+ STRLEN len = strlen (nambeg);
+ return gv_fetchpvn_flags(nambeg, len, add, sv_type);
+}
+
+GV *
+Perl_gv_fetchsv(pTHX_ SV *name, I32 flags, I32 sv_type) {
+ STRLEN len;
+ const char *nambeg = SvPV(name, len);
+ return gv_fetchpvn_flags(nambeg, len, flags | SvUTF8(name), sv_type);
+}
+
+GV *
+Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
+ I32 sv_type)
{
register const char *name = nambeg;
register GV *gv = 0;
GV**gvp;
I32 len;
- register const char *namend;
+ register const char *name_cursor;
HV *stash = 0;
+ I32 add = flags & ~SVf_UTF8;
+ const char *const name_end = nambeg + full_len;
+ const char *const name_em1 = name_end - 1;
- if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */
+ if (full_len 2 && *name == '*' && isALPHA(name[1])) {
+/* accidental stringify on a GV? */
name++;
+ }
- for (namend = name; *namend; namend++) {
-if ((*namend == ':' && namend[1] == ':')
- || (*namend == '\'' && namend[1]))
+ for (name_cursor = name; name_cursor < name_end; name_cursor++) {
+if ((*name_cursor == ':' && name_cursor < name_em1
+ && name_cursor[1] == ':')
+ || (*name_cursor == '\'' && name_cursor[1]))
{
if (!stash)
stash = PL_defstash;
if (!stash || !SvREFCNT(stash)) /* symbol table under destruction */
return NULL;
- len = namend - name;
+ len = name_cursor - name;
if (len 0) {
char smallbuf[256];
char *tmpbuf;
@@ -738,47 +758,56 @@
stash = GvHV(gv) = newHV();
if (!HvNAME_get(stash))
- hv_name_set(stash, nambeg, namend - nambeg, 0);
+ hv_name_set(stash, nambeg, name_cursor - nambeg, 0);
}
- if (*namend == ':')
-namend++;
- namend++;
- name = namend;
- if (!*name)
+ if (*name_cursor == ':')
+name_cursor++;
+ name_cursor++;
+ name = name_cursor;
+ if (name == name_end)
return gv ? gv : (GV*)*hv_fetch(PL_defstash, "main::", 6, TRUE);
}
}
- len = namend - name;
+ len = name_cursor - name;
/* No stash in name, so see how we can default */
if (!stash) {
-if (isIDFIRST_lazy(name)) {
+if (len && isIDFIRST_lazy(name)) {
bool global = FALSE;
- /* name is always \0 terminated, and initial \0 wouldn't return
- true from isIDFIRST_lazy, so we know that name[1] is defined */
- switch (name[1]) {
- case '\0':
+ switch (len) {
+ case 1:
if (*name == '_')
global = TRUE;
break;
- case 'N':
-if (strEQ(name, "INC") || strEQ(name, "ENV"))
+ case 3:
+if ((name[0] == 'I' && name[1] == 'N' && name[2] == 'C')
+ || (name[0] == 'E' && name[1] == 'N' && name[2] == 'V')
+ || (name[0] == 'S' && name[1] == 'I' && name[2] == 'G'))
global = TRUE;
break;
- case 'I':
-if (strEQ(name, "SIG"))
+ case 4:
+if (name[0] == 'A' && name[1] == 'R' && name[2] == 'G'
+ && name[3] == 'V')
global = TRUE;
break;
- case 'T':
-if (strEQ(name, "STDIN") || strEQ(name, "STDUT") ||
- strEQ(name, "STDERR"))
+ case 5:
+if (name[0] == 'S' && name[1] == 'T' && name[2] == 'D'
+ && name[3] == 'I' && name[4] == 'N')
global = TRUE;
break;
- case 'R':
-if (strEQ(name, "ARGV") || strEQ(name, "ARGVUT"))
+ case 6:
+if ((name[0] == 'S' && name[1] == 'T' && name[2] == 'D')
+ &&((name[3] == '' && name[4] == 'U' && name[5] == 'T')
+ ||(name[3] == 'E' && name[4] == 'R' && name[5] == 'R')))
+ global = TRUE;
+break;
+ case 7:
+if (name[0] == 'A' && name[1] == 'R' && name[2] == 'G'
+ && name[3] == 'V' && name[4] == '' && name[5] == 'U'
+ && name[6] == 'T')
global = TRUE;
break;
}
@@ -1183,7 +1212,7 @@
SBJECT_on(io);
/* Clear the stashcache because a new I could overrule a package name */
hv_clear(PL_stashcache);
- iogv = gv_fetchpv("FileHandle::", FALSE, SVt_PVHV);
+ iogv = gv_fetchpv("FileHandle::", 0, SVt_PVHV);
/* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */
if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
iogv = gv_fetchpv("I::Handle::", TRUE, SVt_PVHV);
@@ -1844,6 +1873,22 @@
/*
=for apidoc is_gv_magical
+Returns C<TRUEif given the name of a magical GV. Calls is_gv_magical.
+
+=cut
+*/
+
+bool
+Perl_is_gv_magical_sv(pTHX_ SV *name, U32 flags)
+{
+ STRLEN len;
+ char *temp = SvPV(name, len);
+ return is_gv_magical(temp, len, flags);
+}
+
+/*
+=for apidoc is_gv_magical
+
Returns C<TRUEif given the name of a magical GV.
Currently only useful internally when determining if a GV should be
//depot/maint-5.8/perl/gv.h#12 (text)
Index: perl/gv.h
perl/gv.h#11~27310~2006-02-24 05:20:45.000000000 -0800
perl/gv.h2006-05-11 03:03:53.000000000 -0700
@@ -161,7 +161,9 @@
#define GV_ADDWARN0x04/* add, but warn if symbol wasn't already there */
#define GV_ADDINEVAL0x08/* add, as though we're doing so within an eval */
#define GV_NINIT0x10/* add, but don't init symbol, if type != PVGV */
-
+/* SVf_UTF8 (more accurately the return value from SvUTF8) is also valid
+as a flag to gv_fetch_pvn_flags, so ensure it lies outside this range.
+*/
#define gv_fullname3(sv,gv,prefix) gv_fullname4(sv,gv,prefix,TRUE)
#define gv_efullname3(sv,gv,prefix) gv_efullname4(sv,gv,prefix,TRUE)
#define gv_fetchmethod(stash, name) gv_fetchmethod_autoload(stash, name, TRUE)
//depot/maint-5.8/perl/mg.c#112 (text)
Index: perl/mg.c
perl/mg.c#111~28129~2006-05-08 13:15:44.000000000 -0700
perl/mg.c2006-05-11 03:03:53.000000000 -0700
@@ -1854,17 +1854,12 @@
int
Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg)
{
- register char *s;
GV* gv;
- STRLEN n_a;
PERL_UNUSED_ARG(mg);
if (!SK(sv))
return 0;
- s = SvPV(sv, n_a);
- if (*s == '*' && s[1])
-s++;
- gv = gv_fetchpv(s,TRUE, SVt_PVGV);
+ gv = gv_fetchsv(sv, GV_ADD, SVt_PVGV);
if (sv == (SV*)gv)
return 0;
if (GvGP(sv))
@@ -2322,12 +2317,12 @@
case '^':
Safefree(IoTP_NAME(GvI(PL_defoutgv)));
s = IoTP_NAME(GvI(PL_defoutgv)) = savesvpv(sv);
-IoTP_GV(GvI(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVI);
+IoTP_GV(GvI(PL_defoutgv)) = gv_fetchsv(sv, GV_ADD, SVt_PVI);
break;
case '~':
Safefree(IoFMT_NAME(GvI(PL_defoutgv)));
s = IoFMT_NAME(GvI(PL_defoutgv)) = savesvpv(sv);
-IoFMT_GV(GvI(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVI);
+IoFMT_GV(GvI(PL_defoutgv)) = gv_fetchsv(sv, GV_ADD, SVt_PVI);
break;
case '=':
IoPAGE_LEN(GvI(PL_defoutgv)) = (SvIK(sv) ? SvIVX(sv) : sv_2iv(sv));
@@ -2732,7 +2727,7 @@
if (!SvRK(PL_psig_ptr[sig]) || !(cv = (CV*)SvRV(PL_psig_ptr[sig]))
|| SvTYPE(cv) != SVt_PVCV) {
HV *st;
-cv = sv_2cv(PL_psig_ptr[sig],&st,&gv,TRUE);
+cv = sv_2cv(PL_psig_ptr[sig], &st, &gv, GV_ADD);
}
if (!cv || !CvRT(cv)) {
//depot/maint-5.8/perl/op.c#133 (text)
Index: perl/op.c
perl/op.c#132~28154~2006-05-10 11:31:34.000000000 -0700
perl/op.c2006-05-11 03:03:53.000000000 -0700
@@ -2052,7 +2052,7 @@
o2 = P(P_THREADSV, 0);
o2->op_targ = find_threadsv(";");
#else
-o2 = newSVREF(newGVP(P_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))),
+o2 = newSVREF(newGVP(P_GV, 0, gv_fetchpv(";", GV_ADD, SVt_PV))),
#endif /* USE_5005THREADS */
o = convert(P_JIN, 0, prepend_elem(P_LIST, o2, o));
}
@@ -3283,7 +3283,7 @@
GV *gv = Nullgv;
if (!force_builtin) {
-gv = gv_fetchpv("do", FALSE, SVt_PVCV);
+gv = gv_fetchpv("do", 0, SVt_PVCV);
if (!(gv && GvCVu(gv) && GvIMPRTED_CV(gv))) {
GV **gvp = (GV**)hv_fetch(PL_globalstash, "do", 2, FALSE);
if (gvp) gv = *gvp; else gv = Nullgv;
@@ -4325,9 +4325,10 @@
/* There may be future conflict here as change 23766 is not yet merged. */
gv_fetch_flags = (block || attrs || (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS))
? GV_ADDMULTI : GV_ADDMULTI | GV_NINIT;
- gv = gv_fetchpv(name ? name : (aname ? aname :
- (PL_curstash ? "__ANN__" : "__ANN__::__ANN__")),
- gv_fetch_flags, SVt_PVCV);
+ gv = name ? gv_fetchsv(cSVPo->op_sv, gv_fetch_flags, SVt_PVCV)
+: gv_fetchpv(aname ? aname
+ : (PL_curstash ? "__ANN__" : "__ANN__::__ANN__"),
+ gv_fetch_flags, SVt_PVCV);
if (o)
SAVEFREEP(o);
@@ -4812,15 +4813,13 @@
Perl_newFRM(pTHX_ I32 floor, P *o, P *block)
{
register CV *cv;
- char *name;
GV *gv;
- STRLEN n_a;
if (o)
-name = SvPVx(cSVPo->op_sv, n_a);
+gv = gv_fetchsv(cSVPo->op_sv, GV_ADD, SVt_PVFM);
else
-name = "STDUT";
- gv = gv_fetchpv(name,TRUE, SVt_PVFM);
+gv = gv_fetchpv("STDUT", GV_ADD, SVt_PVFM);
+
#ifdef GV_UNIQUE_CHECK
if (GvUNIQUE(gv)) {
Perl_croak(aTHX_ "Bad symbol for form (GV is unique)");
@@ -4832,7 +4831,9 @@
const line_t oldline = CopLINE(PL_curcop);
if (PL_copline != NLINE)
CopLINE_set(PL_curcop, PL_copline);
- Perl_warner(aTHX_ packWARN(WARN_REDEFINE), "Format %s redefined",name);
+ Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
+o ? "Format %"SVf" redefined"
+: "Format STDUT redefined" ,cSVPo->op_sv);
CopLINE_set(PL_curcop, oldline);
}
SvREFCNT_dec(cv);
@@ -5225,11 +5226,9 @@
o->op_private |= (PL_hints & HINT_STRICT_REFS);
if (kid->op_type == P_CNST) {
-char *name;
int iscv;
GV *gv;
SV * const kidsv = kid->op_sv;
-STRLEN n_a;
/* Is it a constant from cv_const_sv()? */
if (SvRK(kidsv) && SvREADNLY(kidsv)) {
@@ -5268,7 +5267,6 @@
Perl_croak(aTHX_ "Constant is not %s reference", badtype);
return o;
}
-name = SvPV(kidsv, n_a);
if ((PL_hints & HINT_STRICT_REFS) && (kid->op_private & PpCNST_BARE)) {
const char *badthing = NULL;
switch (o->op_type) {
@@ -5284,8 +5282,8 @@
}
if (badthing)
Perl_croak(aTHX_
- "Can't use bareword (\"%s\") as %s ref while \"strict refs\" in use",
- name, badthing);
+ "Can't use bareword (\"%"SVf"\") as %s ref while \"strict refs\" in use",
+ kidsv, badthing);
}
/*
* This is a little tricky. We only want to add the symbol if we
@@ -5297,7 +5295,7 @@
*/
iscv = (o->op_type == P_RV2CV) * 2;
do {
- gv = gv_fetchpv(name,
+ gv = gv_fetchsv(kidsv,
iscv | !(kid->op_private & PpCNST_ENTERED),
iscv
? SVt_PVCV
@@ -5340,9 +5338,8 @@
SVP * const kid = (SVP*)cUNPo->op_first;
if (kid->op_type == P_CNST && (kid->op_private & PpCNST_BARE)) {
- STRLEN n_a;
P * const newop = newGVP(type, Pf_REF,
-gv_fetchpv(SvPVx(kid->op_sv, n_a), TRUE, SVt_PVI));
+gv_fetchsv(kid->op_sv, GV_ADD, SVt_PVI));
op_free(o);
o = newop;
}
@@ -5376,7 +5373,6 @@
}
if (o->op_flags & Pf_KIDS) {
-STRLEN n_a;
P **tokid = &cLISTPo->op_first;
register P *kid = cLISTPo->op_first;
P *sibl;
@@ -5422,13 +5418,12 @@
if (kid->op_type == P_CNST &&
(kid->op_private & PpCNST_BARE))
{
- char *name = SvPVx(((SVP*)kid)->op_sv, n_a);
P * const newop = newAVREF(newGVP(P_GV, 0,
-gv_fetchpv(name, TRUE, SVt_PVAV) ));
+gv_fetchsv(((SVP*)kid)->op_sv, GV_ADD, SVt_PVAV) ));
if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX))
Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
- "Array @%s missing the @ in argument %"IVdf" of %s()",
- name, (IV)numargs, PL_op_desc[type]);
+ "Array @%"SVf" missing the @ in argument %"IVdf" of %s()",
+ ((SVP*)kid)->op_sv, (IV)numargs, PL_op_desc[type]);
op_free(kid);
kid = newop;
kid->op_sibling = sibl;
@@ -5442,13 +5437,12 @@
if (kid->op_type == P_CNST &&
(kid->op_private & PpCNST_BARE))
{
- char *name = SvPVx(((SVP*)kid)->op_sv, n_a);
P * const newop = newHVREF(newGVP(P_GV, 0,
-gv_fetchpv(name, TRUE, SVt_PVHV) ));
+gv_fetchsv(((SVP*)kid)->op_sv, GV_ADD, SVt_PVHV) ));
if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX))
Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
- "Hash %%%s missing the %% in argument %"IVdf" of %s()",
- name, (IV)numargs, PL_op_desc[type]);
+ "Hash %%%"SVf" missing the %% in argument %"IVdf" of %s()",
+ ((SVP*)kid)->op_sv, (IV)numargs, PL_op_desc[type]);
op_free(kid);
kid = newop;
kid->op_sibling = sibl;
@@ -5475,8 +5469,7 @@
(kid->op_private & PpCNST_BARE))
{
P *newop = newGVP(P_GV, 0,
- gv_fetchpv(SvPVx(((SVP*)kid)->op_sv, n_a), TRUE,
-SVt_PVI) );
+ gv_fetchsv(((SVP*)kid)->op_sv, GV_ADD, SVt_PVI));
if (!(o->op_private & 1) && /* if not unop */
kid == cLISTPo->op_last)
cLISTPo->op_last = newop;
@@ -5625,10 +5618,10 @@
if ((o->op_flags & Pf_KIDS) && !cLISTPo->op_first->op_sibling)
append_elem(P_GLB, o, newDEFSVP());
- if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV))
+ if (!((gv = gv_fetchpv("glob", 0, SVt_PVCV))
&& GvCVu(gv) && GvIMPRTED_CV(gv)))
{
-gv = gv_fetchpv("CRE::GLBAL::glob", FALSE, SVt_PVCV);
+gv = gv_fetchpv("CRE::GLBAL::glob", 0, SVt_PVCV);
}
#if !defined(PERL_EXTERNAL_GLB)
@@ -5638,8 +5631,8 @@
ENTER;
Perl_load_module(aTHX_ PERL_LADMD_NIMPRT,
newSVpvn("File::Glob", 10), NULL, NULL, NULL);
-gv = gv_fetchpv("CRE::GLBAL::glob", FALSE, SVt_PVCV);
-glob_gv = gv_fetchpv("File::Glob::csh_glob", FALSE, SVt_PVCV);
+gv = gv_fetchpv("CRE::GLBAL::glob", 0, SVt_PVCV);
+glob_gv = gv_fetchpv("File::Glob::csh_glob", 0, SVt_PVCV);
GvCV(gv) = GvCV(glob_gv);
SvREFCNT_inc_void((SV*)GvCV(gv));
GvIMPRTED_CV_on(gv);
@@ -5987,7 +5980,7 @@
if (!(o->op_flags & Pf_SPECIAL)) { /* Wasn't written as CRE::require */
/* handle override, if any */
-gv = gv_fetchpv("require", FALSE, SVt_PVCV);
+gv = gv_fetchpv("require", 0, SVt_PVCV);
if (!(gv && GvCVu(gv) && GvIMPRTED_CV(gv)))
gv = gv_fetchpv("CRE::GLBAL::require", FALSE, SVt_PVCV);
}
@@ -6138,8 +6131,8 @@
const char *gvname;
if (!(o->op_flags & Pf_STACKED))
return;
- GvMULTI_on(gv_fetchpv("a", TRUE, SVt_PV));
- GvMULTI_on(gv_fetchpv("b", TRUE, SVt_PV));
+ GvMULTI_on(gv_fetchpv("a", GV_ADD, SVt_PV));
+ GvMULTI_on(gv_fetchpv("b", GV_ADD, SVt_PV));
kid = kUNP->op_first;/* get past null */
if (kid->op_type != P_SCPE)
return;
//depot/maint-5.8/perl/perl.c#165 (text)
Index: perl/perl.c
perl/perl.c#164~28129~2006-05-08 13:15:44.000000000 -0700
perl/perl.c2006-05-11 03:03:53.000000000 -0700
@@ -4577,8 +4577,9 @@
break;
}
if ((s = strchr(argv[0], '='))) {
-*s++ = '\0';
-sv_setpv(GvSV(gv_fetchpv(argv[0]+1,TRUE, SVt_PV)),s);
+const char *const start_name = argv[0] + 1;
+sv_setpv(GvSV(gv_fetchpvn_flags(start_name, s - start_name,
+TRUE, SVt_PV)), s + 1);
}
else
sv_setiv(GvSV(gv_fetchpv(argv[0]+1,TRUE, SVt_PV)),1);
//depot/maint-5.8/perl/perl.h#118 (text)
Index: perl/perl.h
perl/perl.h#117~28129~2006-05-08 13:15:44.000000000 -0700
perl/perl.h2006-05-11 03:03:53.000000000 -0700
@@ -3734,6 +3734,8 @@
INIT("Can't use %s ref as %s ref");
EXTCNST char PL_no_symref[]
INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use");
+EXTCNST char PL_no_symref_sv[]
+ INIT("Can't use string (\"%.32" SVf "\") as %s ref while \"strict refs\" in use");
EXTCNST char PL_no_usym[]
INIT("Can't use an undefined value as %s reference");
EXTCNST char PL_no_aelem[]
//depot/maint-5.8/perl/pp.c#96 (text)
Index: perl/pp.c
perl/pp.c#95~28129~2006-05-08 13:15:44.000000000 -0700
perl/pp.c2006-05-11 03:03:53.000000000 -0700
@@ -145,9 +145,6 @@
}
else {
if (SvTYPE(sv) != SVt_PVGV) {
- char *sym;
- STRLEN len;
-
if (SvGMAGICAL(sv)) {
mg_get(sv);
if (SvRK(sv))
@@ -191,22 +188,21 @@
report_uninit();
RETSETUNDEF;
}
- sym = SvPV(sv,len);
if ((PL_op->op_flags & Pf_SPECIAL) &&
!(PL_op->op_flags & Pf_MD))
{
-sv = (SV*)gv_fetchpv(sym, FALSE, SVt_PVGV);
-if (!sv
- && (!is_gv_magical(sym,len,0)
-|| !(sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV))))
-{
+SV * temp = (SV*)gv_fetchsv(sv, 0, SVt_PVGV);
+if (!temp
+ && (!is_gv_magical_sv(sv,0)
+|| !(sv = (SV*)gv_fetchsv(sv, GV_ADD, SVt_PVGV)))) {
RETSETUNDEF;
}
+sv = temp;
}
else {
if (PL_op->op_private & HINT_STRICT_REFS)
- DIE(aTHX_ PL_no_symref, sym, "a symbol");
-sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
+ DIE(aTHX_ PL_no_symref_sv, sv, "a symbol");
+sv = (SV*)gv_fetchsv(sv, GV_ADD, SVt_PVGV);
}
}
}
@@ -234,8 +230,6 @@
}
}
else {
-char *sym;
-STRLEN len;
gv = (GV*)sv;
if (SvTYPE(gv) != SVt_PVGV) {
@@ -252,22 +246,21 @@
report_uninit();
RETSETUNDEF;
}
- sym = SvPV(sv, len);
if ((PL_op->op_flags & Pf_SPECIAL) &&
!(PL_op->op_flags & Pf_MD))
{
-gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PV);
+gv = (GV*)gv_fetchsv(sv, 0, SVt_PV);
if (!gv
- && (!is_gv_magical(sym,len,0)
-|| !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV))))
+ && (!is_gv_magical_sv(sv, 0)
+|| !(gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PV))))
{
RETSETUNDEF;
}
}
else {
if (PL_op->op_private & HINT_STRICT_REFS)
- DIE(aTHX_ PL_no_symref, sym, "a SCALAR");
-gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
+ DIE(aTHX_ PL_no_symref_sv, sv, "a SCALAR");
+gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PV);
}
}
sv = GvSVn(gv);
@@ -344,7 +337,8 @@
/* We usually try to add a non-existent subroutine in case of AUTLAD. */
/* (But not in defined().) */
- CV *cv = sv_2cv(TPs, &stash, &gv, !(PL_op->op_flags & Pf_SPECIAL));
+ CV *cv = sv_2cv(TPs, &stash, &gv,
+ (PL_op->op_flags & Pf_SPECIAL) ? 0 : GV_ADD);
if (cv) {
if (CvCLNE(cv))
cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
@@ -420,7 +414,7 @@
}
}
}
- cv = sv_2cv(TPs, &stash, &gv, FALSE);
+ cv = sv_2cv(TPs, &stash, &gv, 0);
if (cv && SvPK(cv))
ret = sv_2mortal(newSVpvn(SvPVX_const(cv), SvCUR(cv)));
set:
@@ -3771,7 +3765,7 @@
if (PL_op->op_private & PpEXISTS_SUB) {
GV *gv;
SV *sv = PPs;
-CV * const cv = sv_2cv(sv, &hv, &gv, FALSE);
+CV * const cv = sv_2cv(sv, &hv, &gv, 0);
if (cv)
RETPUSHYES;
if (gv && isGV(gv) && GvCV(gv) && !GvCVGEN(gv))
//depot/maint-5.8/perl/pp_hot.c#99 (text)
Index: perl/pp_hot.c
perl/pp_hot.c#98~28129~2006-05-08 13:15:44.000000000 -0700
perl/pp_hot.c2006-05-11 03:03:53.000000000 -0700
@@ -695,9 +695,6 @@
GV *gv;
if (SvTYPE(sv) != SVt_PVGV) {
-char *sym;
-STRLEN len;
-
if (SvGMAGICAL(sv)) {
mg_get(sv);
if (SvRK(sv))
@@ -715,22 +712,21 @@
}
RETSETUNDEF;
}
-sym = SvPV(sv,len);
if ((PL_op->op_flags & Pf_SPECIAL) &&
!(PL_op->op_flags & Pf_MD))
{
- gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PVAV);
+ gv = (GV*)gv_fetchsv(sv, 0, SVt_PVAV);
if (!gv
-&& (!is_gv_magical(sym,len,0)
- || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV))))
+&& (!is_gv_magical_sv(sv,0)
+ || !(gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PVAV))))
{
RETSETUNDEF;
}
}
else {
if (PL_op->op_private & HINT_STRICT_REFS)
-DIE(aTHX_ PL_no_symref, sym, "an ARRAY");
- gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV);
+DIE(aTHX_ PL_no_symref_sv, sv, "an ARRAY");
+ gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PVAV);
}
}
else {
@@ -826,9 +822,6 @@
GV *gv;
if (SvTYPE(sv) != SVt_PVGV) {
-char *sym;
-STRLEN len;
-
if (SvGMAGICAL(sv)) {
mg_get(sv);
if (SvRK(sv))
@@ -846,22 +839,21 @@
}
RETSETUNDEF;
}
-sym = SvPV(sv,len);
if ((PL_op->op_flags & Pf_SPECIAL) &&
!(PL_op->op_flags & Pf_MD))
{
- gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PVHV);
+ gv = (GV*)gv_fetchsv(sv, 0, SVt_PVHV);
if (!gv
-&& (!is_gv_magical(sym,len,0)
- || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV))))
+&& (!is_gv_magical_sv(sv,0)
+ || !(gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PVHV))))
{
RETSETUNDEF;
}
}
else {
if (PL_op->op_private & HINT_STRICT_REFS)
-DIE(aTHX_ PL_no_symref, sym, "a HASH");
- gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV);
+DIE(aTHX_ PL_no_symref_sv, sv, "a HASH");
+ gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PVHV);
}
}
else {
@@ -2636,7 +2628,7 @@
break;
case SVt_PVGV:
if (!(cv = GvCVu((GV*)sv)))
- cv = sv_2cv(sv, &stash, &gv, FALSE);
+ cv = sv_2cv(sv, &stash, &gv, 0);
if (!cv) {
ENTER;
SAVETMPS;
@@ -3147,7 +3139,7 @@
if (!SK(sv) ||
!(packname) ||
- !(iogv = gv_fetchpv(packname, FALSE, SVt_PVI)) ||
+ !(iogv = gv_fetchsv(sv, 0, SVt_PVI)) ||
!(ob=(SV*)GvI(iogv)))
{
/* this isn't the name of a filehandle either */
//depot/maint-5.8/perl/pp_sys.c#106 (text)
Index: perl/pp_sys.c
perl/pp_sys.c#105~28129~2006-05-08 13:15:44.000000000 -0700
perl/pp_sys.c2006-05-11 03:03:53.000000000 -0700
@@ -1332,14 +1332,14 @@
if (!IoFMT_NAME(io))
IoFMT_NAME(io) = savepv(GvNAME(gv));
topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TP", GvNAME(gv)));
-topgv = gv_fetchpv(SvPVX(topname), FALSE, SVt_PVFM);
+topgv = gv_fetchsv(topname, 0, SVt_PVFM);
if ((topgv && GvFRM(topgv)) ||
- !gv_fetchpv("top",FALSE,SVt_PVFM))
+ !gv_fetchpv("top", 0, SVt_PVFM))
IoTP_NAME(io) = savesvpv(topname);
else
IoTP_NAME(io) = savepv("top");
}
- topgv = gv_fetchpv(IoTP_NAME(io),FALSE, SVt_PVFM);
+ topgv = gv_fetchpv(IoTP_NAME(io), 0, SVt_PVFM);
if (!topgv || !GvFRM(topgv)) {
IoLINES_LEFT(io) = IoPAGE_LEN(io);
goto forget_top;
@@ -2095,7 +2095,7 @@
I *io;
if (PL_op->op_flags & Pf_SPECIAL) {
- tmpgv = gv_fetchpv(PPpx, FALSE, SVt_PVI);
+ tmpgv = gv_fetchsv(PPs, 0, SVt_PVI);
do_ftruncate_gv:
if (!GvI(tmpgv))
@@ -2122,7 +2122,7 @@
else {
SV *sv = PPs;
const char *name;
-
+
if (SvTYPE(sv) == SVt_PVGV) {
tmpgv = (GV*)sv;/* *main::FRED for example */
goto do_ftruncate_gv;
@@ -3085,7 +3085,8 @@
dSP;
int fd;
GV *gv;
- char *tmps = NULL;
+ SV *tmpsv = NULL;
+
if (PL_op->op_flags & Pf_REF)
gv = cGVP_gv;
@@ -3094,12 +3095,18 @@
else if (SvRK(TPs) && isGV(SvRV(TPs)))
gv = (GV*)SvRV(PPs);
else
-gv = gv_fetchpv(tmps = PPpx, FALSE, SVt_PVI);
+gv = gv_fetchsv(tmpsv = PPs, 0, SVt_PVI);
if (GvI(gv) && IoIFP(GvI(gv)))
fd = PerlI(IoIFP(GvI(gv)));
- else if (tmps && isDIGIT(*tmps))
-fd = atoi(tmps);
+ else if (tmpsv && SK(tmpsv)) {
+STRLEN n_a;
+char *tmps = SvPV(tmpsv, n_a);
+if (isDIGIT(*tmps))
+ fd = atoi(tmps);
+else
+ RETPUSHUNDEF;
+ }
else
RETPUSHUNDEF;
if (PerlLI(fd))
@@ -3822,7 +3829,7 @@
if (childpid < 0)
RETSETUNDEF;
if (!childpid) {
-if ((tmpgv = gv_fetchpv("$", TRUE, SVt_PV))) {
+if ((tmpgv = gv_fetchpv("$", GV_ADD, SVt_PV))) {
SvREADNLY_off(GvSV(tmpgv));
sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
SvREADNLY_on(GvSV(tmpgv));
//depot/maint-5.8/perl/proto.h#137 (text+w)
Index: perl/proto.h
perl/proto.h#136~28154~2006-05-10 11:31:34.000000000 -0700
perl/proto.h2006-05-11 03:03:53.000000000 -0700
@@ -2179,6 +2179,10 @@
PERL_CALLCNV voidPerl_my_swabn(void* ptr, int n);
+PERL_CALLCNV GV*Perl_gv_fetchpvn_flags(pTHX_ const char* name, STRLEN len, I32 flags, I32 sv_type);
+PERL_CALLCNV GV*Perl_gv_fetchsv(pTHX_ SV *name, I32 flags, I32 sv_type);
+PERL_CALLCNV boolPerl_is_gv_magical_sv(pTHX_ SV *name, U32 flags);
+
#if defined(PERL_INP_C) || defined(PERL_DECL_PRT)
PERL_CALLCNV P*Perl_ck_anoncode(pTHX_ P *o)
;
//depot/maint-5.8/perl/regcomp.c#68 (text)
Index: perl/regcomp.c
perl/regcomp.c#67~28129~2006-05-08 13:15:44.000000000 -0700
perl/regcomp.c2006-05-11 03:03:53.000000000 -0700
@@ -5109,7 +5109,7 @@
GV *mgv;
char digits[TYPE_CHARS(long)];
sprintf(digits, "%lu", (long)i);
-if ((mgv = gv_fetchpv(digits, FALSE, SVt_PV)))
+if ((mgv = gv_fetchpv(digits, 0, SVt_PV)))
save_scalar(mgv);
}
}
//depot/maint-5.8/perl/sv.c#252 (text)
Index: perl/sv.c
perl/sv.c#251~28129~2006-05-08 13:15:44.000000000 -0700
perl/sv.c2006-05-11 03:03:53.000000000 -0700
@@ -6613,7 +6613,6 @@
{
I* io;
GV* gv;
- STRLEN n_a;
switch (SvTYPE(sv)) {
case SVt_PVI:
@@ -6630,7 +6629,7 @@
Perl_croak(aTHX_ PL_no_usym, "filehandle");
if (SvRK(sv))
return sv_2io(SvRV(sv));
-gv = gv_fetchpv(SvPV(sv,n_a), FALSE, SVt_PVI);
+gv = gv_fetchsv(sv, 0, SVt_PVI);
if (gv)
io = GvI(gv);
else
@@ -6647,6 +6646,7 @@
Using various gambits, try to get a CV from an SV; in addition, try if
possible to set C<*stand C<*gvpto the stash and GV associated with it.
+The flags in C<lrefare passed to sv_fetchsv.
=cut
*/
@@ -6656,7 +6656,6 @@
{
GV *gv = NULL;
CV *cv = Nullcv;
- STRLEN n_a;
if (!sv)
return *gvp = NULL, NULL;
@@ -6696,7 +6695,7 @@
else if (isGV(sv))
gv = (GV*)sv;
else
- gv = gv_fetchpv(SvPV(sv, n_a), lref, SVt_PVCV);
+ gv = gv_fetchsv(sv, lref, SVt_PVCV);
*gvp = gv;
if (!gv)
return Nullcv;
//depot/maint-5.8/perl/sv.h#59 (text)
Index: perl/sv.h
perl/sv.h#58~28130~2006-05-08 13:44:45.000000000 -0700
perl/sv.h2006-05-11 03:03:53.000000000 -0700
@@ -286,6 +286,7 @@
#define SVp_SCREAM0x08000000/* has been studied? */
#define SVf_UTF8 0x20000000 /* SvPV is UTF-8 encoded */
+/* Ensure this value does not clash with the GV_ADD* flags in gv.h */
#define SVf_THINKFIRST(SVf_READNLY|SVf_RK|SVf_FAKE)
@@ -739,6 +740,8 @@
=cut
*/
+/* Ensure the return value of this macro does not clash with the GV_ADD* flags
+in gv.h: */
#define SvUTF8(sv)(SvFLAGS(sv) & SVf_UTF8)
#define SvUTF8_on(sv)(SvFLAGS(sv) |= (SVf_UTF8))
#define SvUTF8_off(sv)(SvFLAGS(sv) &= ~(SVf_UTF8))
//#8 (xtext)
Index: perl/t/op/ref.t
perl/t/op/ref.t#7~23833~2005-01-20 03:26:12.000000000 -0800
perl/t/op/ref.t2006-05-11 03:03:53.000000000 -0700
@@ -8,7 +8,7 @@
require 'test.pl';
use strict qw(refs subs);
-plan (74);
+plan (89);
# Test glob operations.
@@ -378,6 +378,52 @@
stderr =1
), qr/^(ok)+$/, 'STDUT destructor');
+TD: {
+ no strict 'refs';
+ $name8 = chr 163;
+ $name_utf8 = $name8 . chr 256;
+ chop $name_utf8;
+
+ is ($$name8, undef, 'Nothing before we start');
+ is ($$name_utf8, undef, 'Nothing before we start');
+ $$name8 = "Pound";
+ is ($$name8, "Pound", 'Accessing via 8 bit symref works');
+ local $TD = "UTF8 mangled in symrefs";
+ is ($$name_utf8, "Pound", 'Accessing via UTF8 symref works');
+}
+
+TD: {
+ no strict 'refs';
+ $name_utf8 = $name = chr 9787;
+ utf8::encode $name_utf8;
+
+ is (length $name, 1, "Name is 1 char");
+ is (length $name_utf8, 3, "UTF8 representation is 3 chars");
+
+ is ($$name, undef, 'Nothing before we start');
+ is ($$name_utf8, undef, 'Nothing before we start');
+ $$name = "Face";
+ is ($$name, "Face", 'Accessing via Unicode symref works');
+ local $TD = "UTF8 mangled in symrefs";
+ is ($$name_utf8, undef,
+'Accessing via the UTF8 byte sequence gives nothing');
+}
+
+TD: {
+ no strict 'refs';
+ $name1 = "\0Chalk";
+ $name2 = "\0Cheese";
+
+ isnt ($name1, $name2, "They differ");
+
+ is ($$name1, undef, 'Nothing before we start');
+ is ($$name2, undef, 'Nothing before we start');
+ $$name1 = "Yummy";
+ is ($$name1, "Yummy", 'Accessing via the correct name works');
+ is ($$name2, undef,
+'Accessing via a different NUL-containing name gives nothing');
+}
+
# Bit of a hack to make test.pl happy. There are 3 more tests after it leaves.
$test = curr_test();
curr_test($test + 3);
//depot/maint-5.8/perl/toke.c#112 (text)
Index: perl/toke.c
perl/toke.c#111~28153~2006-05-10 10:44:54.000000000 -0700
perl/toke.c2006-05-11 03:03:53.000000000 -0700
@@ -938,6 +938,15 @@
}
}
+STATIC SV *
+S_newSV_maybe_utf8(pTHX_ const char *start, STRLEN len)
+{
+ SV *sv = newSVpvn(start,len);
+ if (UTF && !IN_BYTES && is_utf8_string((U8*)start, len))
+SvUTF8_on(sv);
+ return sv;
+}
+
/*
* S_force_word
* When the lexer knows the next thing is a word (for instance, it has
@@ -977,10 +986,10 @@
PL_expect = XPERATR;
}
}
-PL_nextval[PL_nexttoke].opval = (P*)newSVP(P_CNST,0, newSVpv(PL_tokenbuf,0));
+PL_nextval[PL_nexttoke].opval
+ = (P*)newSVP(P_CNST,0,
+ S_newSV_maybe_utf8(aTHX_ PL_tokenbuf, len));
PL_nextval[PL_nexttoke].opval->op_private |= PpCNST_BARE;
-if (UTF && !IN_BYTES && is_utf8_string((U8*)PL_tokenbuf, len))
- SvUTF8_on(((SVP*)PL_nextval[PL_nexttoke].opval)->op_sv);
force_next(token);
}
return s;
@@ -1007,7 +1016,7 @@
/* XXX see note in pp_entereval() for why we forgo typo
warnings if the symbol must be introduced in an eval.
GSAR 96-10-12 */
- gv_fetchpv(s, PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : TRUE,
+ gv_fetchpv(s, PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : GV_ADD,
kind == '$' ? SVt_PV :
kind == '@' ? SVt_PVAV :
kind == '%' ? SVt_PVHV :
@@ -1999,7 +2008,8 @@
weight -= seen[un_char] * 10;
if (isALNUM_lazy_if(s+1,UTF)) {
scan_ident(s, send, tmpbuf, sizeof tmpbuf, FALSE);
- if ((int)strlen(tmpbuf) 1 && gv_fetchpv(tmpbuf,FALSE, SVt_PV))
+ if ((int)strlen(tmpbuf) 1
+&& gv_fetchpv(tmpbuf, 0, SVt_PV))
weight -= 100;
else
weight -= 10;
@@ -2130,7 +2140,7 @@
tmpbuf[len] = '\0';
goto bare_package;
}
-indirgv = gv_fetchpv(tmpbuf, FALSE, SVt_PVCV);
+indirgv = gv_fetchpv(tmpbuf, 0, SVt_PVCV);
if (indirgv && GvCVu(indirgv))
return 0;
/* filehandle or package name makes it a method */
@@ -2324,13 +2334,13 @@
if (len 2 &&
(pkgname[len - 2] == ':' && pkgname[len - 1] == ':') &&
- (gv = gv_fetchpv(pkgname, FALSE, SVt_PVHV)))
+ (gv = gv_fetchpv(pkgname, 0, SVt_PVHV)))
{
return GvHV(gv);/* Foo:: */
}
/* use constant CLASS ='MyClass' */
- if ((gv = gv_fetchpv(pkgname, FALSE, SVt_PVCV))) {
+ if ((gv = gv_fetchpv(pkgname, 0, SVt_PVCV))) {
SV *sv;
if (GvCV(gv) && (sv = cv_const_sv(GvCV(gv)))) {
pkgname = SvPV_nolen_const(sv);
@@ -2860,7 +2870,8 @@
* at least, set argv[0] to the basename of the Perl
* interpreter. So, having found "#!", we'll set it right.
*/
- SV * const x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV)); /* $^X */
+ SV * const x
+= GvSV(gv_fetchpv("\030", GV_ADD, SVt_PV)); /* $^X */
assert(SvPK(x) || SvGMAGICAL(x));
if (sv_eq(x, CopFILESV(PL_curcop))) {
sv_setpvn(x, ipath, ipathend - ipath);
@@ -3091,7 +3102,7 @@
case 'T': ftst = P_FTTEXT;break;
case 'B': ftst = P_FTBINARY;break;
case 'M': case 'A': case 'C':
-gv_fetchpv("\024",TRUE, SVt_PV);
+gv_fetchpv("\024",GV_ADD, SVt_PV);
switch (tmp) {
case 'M': ftst = P_FTMTIME;break;
case 'A': ftst = P_FTATIME;break;
@@ -3979,7 +3990,7 @@
const char c = *start;
GV *gv;
*start = '\0';
-gv = gv_fetchpv(s, FALSE, SVt_PVCV);
+gv = gv_fetchpv(s, 0, SVt_PVCV);
*start = c;
if (!gv) {
s = scan_num(s, &yylval);
@@ -4060,10 +4071,10 @@
/* Is this a word before a =operator? */
if (*d == '=' && d[1] == '>') {
CLINE;
- yylval.opval = (P*)newSVP(P_CNST, 0, newSVpv(PL_tokenbuf,0));
+ yylval.opval
+= (P*)newSVP(P_CNST, 0,
+ S_newSV_maybe_utf8(aTHX_ PL_tokenbuf, len));
yylval.opval->op_private = PpCNST_BARE;
- if (UTF && !IN_BYTES && is_utf8_string((U8*)PL_tokenbuf, len))
- SvUTF8_on(((SVP*)yylval.opval)->op_sv);
TERM(WRD);
}
@@ -4072,7 +4083,7 @@
GV *hgv = Nullgv;/* hidden (loser) */
if (PL_expect != XPERATR && (*s != ':' || s[1] != ':')) {
CV *cv;
-if ((gv = gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVCV)) &&
+if ((gv = gv_fetchpv(PL_tokenbuf, 0, SVt_PVCV)) &&
(cv = GvCVu(gv)))
{
if (GvIMPRTED_CV(gv))
@@ -4154,7 +4165,8 @@
if (len 2 &&
PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':')
{
- if (ckWARN(WARN_BAREWRD) && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV))
+ if (ckWARN(WARN_BAREWRD)
+&& ! gv_fetchpv(PL_tokenbuf, 0, SVt_PVHV))
Perl_warner(aTHX_ packWARN(WARN_BAREWRD),
"Bareword \"%s\" refers to nonexistent package",
PL_tokenbuf);
@@ -4164,9 +4176,9 @@
gvp = 0;
}
else {
- len = 0;
if (!gv)
-gv = gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVCV);
+gv = gv_fetchpv(PL_tokenbuf, 0, SVt_PVCV);
+ len = 0;
}
/* if we saw a global override before, get the right name */
@@ -4293,6 +4305,17 @@
}
/* Resolve to GV now. */
+#if 0
+ /* Bugfix needed when proxy constant subs are merged. */
+ if (SvTYPE(gv) != SVt_PVGV) {
+gv = gv_fetchpv(PL_tokenbuf, 0, SVt_PVCV);
+assert (SvTYPE(gv) == SVt_PVGV);
+/* cv must have been some sort of placeholder, so
+ now needs replacing with a real code reference. */
+cv = GvCV(gv);
+ }
+#endif
+
op_free(yylval.opval);
yylval.opval = newCVREF(0, newGVP(P_GV, 0, gv));
yylval.opval->op_private |= PpENTERSUB_NPAREN;
@@ -4373,7 +4396,8 @@
const char *pname = "main";
if (PL_tokenbuf[2] == 'D')
pname = HvNAME_get(PL_curstash ? PL_curstash : PL_defstash);
-gv = gv_fetchpv(Perl_form(aTHX_ "%s::DATA", pname), TRUE, SVt_PVI);
+gv = gv_fetchpv(Perl_form(aTHX_ "%s::DATA", pname), GV_ADD,
+SVt_PVI);
GvMULTI_on(gv);
if (!GvI(gv))
GvI(gv) = newI();
@@ -4509,7 +4533,7 @@
PREBLCK(CNTINUE);
case KEY_chdir:
- (void)gv_fetchpv("ENV",TRUE, SVt_PVHV);/* may use HME */
+ (void)gv_fetchpv("ENV", GV_ADD, SVt_PVHV);/* may use HME */
UNI(P_CHDIR);
case KEY_close:
@@ -5465,10 +5489,10 @@
char ctl_l[2];
ctl_l[0] = toCTRL('L');
ctl_l[1] = '\0';
- gv_fetchpv(ctl_l,TRUE, SVt_PV);
+ gv_fetchpv(ctl_l, GV_ADD, SVt_PV);
}
#else
- gv_fetchpv("\f",TRUE, SVt_PV); /* Make sure $^L is defined */
+ gv_fetchpv("\f", GV_ADD, SVt_PV); /* Make sure $^L is defined */
#endif
UNI(P_ENTERWRITE);
@@ -5564,7 +5588,7 @@
sv_catpv(sym, PL_tokenbuf+1);
yylval.opval = (P*)newSVP(P_CNST, 0, sym);
yylval.opval->op_private = PpCNST_ENTERED;
- gv_fetchpv(SvPVX(sym),
+ gv_fetchsv(sym,
(PL_in_eval
? (GV_ADDMULTI | GV_ADDINEVAL)
: GV_ADDMULTI
@@ -5604,7 +5628,7 @@
table.
*/
if (pit == '@' && PL_lex_state != LEX_NRMAL && !PL_lex_brackets) {
- GV *gv = gv_fetchpv(PL_tokenbuf+1, FALSE, SVt_PVAV);
+ GV *gv = gv_fetchpv(PL_tokenbuf+1, 0, SVt_PVAV);
if ((!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
&& ckWARN(WARN_AMBIGUUS))
{
@@ -9064,6 +9088,9 @@
return res;
}
+/* Returns a NUL terminated string, with the length of the string written to
+ *slp
+ */
STATIC char *
S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
{
@@ -9730,7 +9757,7 @@
Copy("ARGV",d,5,char);
/* Check whether readline() is overriden */
-if (((gv_readline = gv_fetchpv("readline", FALSE, SVt_PVCV))
+if (((gv_readline = gv_fetchpv("readline", 0, SVt_PVCV))
&& GvCVu(gv_readline) && GvIMPRTED_CV(gv_readline))
||
((gvp = (GV**)hv_fetch(PL_globalstash, "readline", 8, FALSE))
@@ -9793,7 +9820,7 @@
/* If it's none of the above, it must be a literal filehandle
(<Foo::BARor <F>) so build a simple readline P */
else {
- GV *gv = gv_fetchpv(d,TRUE, SVt_PVI);
+ GV *gv = gv_fetchpv(d, GV_ADD, SVt_PVI);
PL_lex_op = readline_overriden
? (P*)newUNP(P_ENTERSUB, Pf_STACKED,
append_elem(P_LIST,
//#46 (text)
Index: perl/universal.c
perl/universal.c#45~28128~2006-05-08 12:22:03.000000000 -0700
perl/universal.c2006-05-11 03:03:53.000000000 -0700
@@ -609,7 +609,7 @@
if (SvRK(sv) && isGV(SvRV(sv)))
gv = (GV*)SvRV(sv);
else if (SvPKp(sv))
- gv = gv_fetchpv(SvPVX(sv), FALSE, SVt_PVI);
+ gv = gv_fetchsv(sv, 0, SVt_PVI);
}
if (gv && (io = GvI(gv))) {
End of Patch.