diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rwxr-xr-x | embed.pl | 1 | ||||
| -rw-r--r-- | proto.h | 1 | ||||
| -rw-r--r-- | t/op/my_stash.t | 27 | ||||
| -rw-r--r-- | toke.c | 25 |
5 files changed, 54 insertions, 1 deletions
@@ -1438,6 +1438,7 @@ t/op/method.t See if method calls work t/op/misc.t See if miscellaneous bugs have been fixed t/op/mkdir.t See if mkdir works t/op/my.t See if lexical scoping works +t/op/my_stash.t See if my Package works t/op/nothr5005.t local @_ test which does not work under use5005threads t/op/numconvert.t See if accessing fields does not change numeric values t/op/oct.t See if oct and hex work @@ -2484,6 +2484,7 @@ s |I32 |sublex_done s |I32 |sublex_push s |I32 |sublex_start s |char * |filter_gets |SV *sv|PerlIO *fp|STRLEN append +s |HV * |find_in_my_stash|char *pkgname|I32 len s |SV* |new_constant |char *s|STRLEN len|const char *key|SV *sv \ |SV *pv|const char *type s |int |ao |int toketype @@ -1233,6 +1233,7 @@ STATIC I32 S_sublex_done(pTHX); STATIC I32 S_sublex_push(pTHX); STATIC I32 S_sublex_start(pTHX); STATIC char * S_filter_gets(pTHX_ SV *sv, PerlIO *fp, STRLEN append); +STATIC HV * S_find_in_my_stash(pTHX_ char *pkgname, I32 len); STATIC SV* S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv, const char *type); STATIC int S_ao(pTHX_ int toketype); STATIC void S_depcom(pTHX); diff --git a/t/op/my_stash.t b/t/op/my_stash.t new file mode 100644 index 0000000000..ba266bfea2 --- /dev/null +++ b/t/op/my_stash.t @@ -0,0 +1,27 @@ +#!./perl + +package Foo; + +use Test; + +plan tests => 7; + +use constant MyClass => 'Foo::Bar::Biz::Baz'; + +{ + package Foo::Bar::Biz::Baz; +} + +for (qw(Foo Foo:: MyClass __PACKAGE__)) { + eval "sub { my $_ \$obj = shift; }"; + ok ! $@; +# print $@ if $@; +} + +use constant NoClass => 'Nope::Foo::Bar::Biz::Baz'; + +for (qw(Nope Nope:: NoClass)) { + eval "sub { my $_ \$obj = shift; }"; + ok $@; +# print $@ if $@; +} @@ -2006,6 +2006,29 @@ S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append) return (sv_gets(sv, fp, append)); } +STATIC HV *S_find_in_my_stash(pTHX_ char *pkgname, I32 len) +{ + GV *gv; + + if (*pkgname == '_' && strEQ(pkgname, "__PACKAGE__")) + return PL_curstash; + + if (len > 2 && + (pkgname[len - 2] == ':' && pkgname[len - 1] == ':') && + (gv = gv_fetchpv(pkgname, FALSE, SVt_PVHV))) { + return GvHV(gv); /* Foo:: */ + } + + /* use constant CLASS => 'MyClass' */ + if ((gv = gv_fetchpv(pkgname, FALSE, SVt_PVCV))) { + SV *sv; + if (GvCV(gv) && (sv = cv_const_sv(GvCV(gv)))) { + pkgname = SvPV_nolen(sv); + } + } + + return gv_stashpv(pkgname, FALSE); +} #ifdef DEBUGGING static char* exp_name[] = @@ -4410,7 +4433,7 @@ Perl_yylex(pTHX) s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len); if (len == 3 && strnEQ(PL_tokenbuf, "sub", 3)) goto really_sub; - PL_in_my_stash = gv_stashpv(PL_tokenbuf, FALSE); + PL_in_my_stash = find_in_my_stash(PL_tokenbuf, len); if (!PL_in_my_stash) { char tmpbuf[1024]; PL_bufptr = s; |