From: Doug MacEachern Date: Tue, 27 Jun 2000 14:17:28 +0000 (-0700) Subject: Re: [PATCH] support 'my __PACKAGE__ $obj = ...' X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ec6a9911b75518dd4c77eb4985d8bee0371df340;p=p5sagit%2Fp5-mst-13.2.git Re: [PATCH] support 'my __PACKAGE__ $obj = ...' Message-ID: p4raw-id: //depot/cfgperl@6250 --- diff --git a/MANIFEST b/MANIFEST index b21da7d..25765e6 100644 --- a/MANIFEST +++ b/MANIFEST @@ -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 diff --git a/embed.pl b/embed.pl index 96603be..c4cb705 100755 --- a/embed.pl +++ b/embed.pl @@ -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 diff --git a/proto.h b/proto.h index fc34840..d46179a 100644 --- a/proto.h +++ b/proto.h @@ -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 0000000..ba266bf --- /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 $@; +} diff --git a/toke.c b/toke.c index 4c97aea..4a54f72 100644 --- a/toke.c +++ b/toke.c @@ -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;