diff options
| -rw-r--r-- | dump.c | 2 | ||||
| -rw-r--r-- | gv.c | 1 | ||||
| -rw-r--r-- | gv.h | 1 | ||||
| -rw-r--r-- | op.c | 18 | ||||
| -rw-r--r-- | pod/perlfunc.pod | 28 | ||||
| -rw-r--r-- | sv.c | 2 | ||||
| -rw-r--r-- | sv.h | 3 | ||||
| -rw-r--r-- | t/pragma/strict-vars | 32 | ||||
| -rw-r--r-- | toke.c | 14 |
9 files changed, 87 insertions, 14 deletions
@@ -1132,6 +1132,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv)); do_hv_dump (level, file, " GvSTASH", GvSTASH(sv)); Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv))); + if (!GvGP(sv)) + break; Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv))); Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv)); Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv))); @@ -533,7 +533,6 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) else if ((COP*)PL_curcop == &PL_compiling) { stash = PL_curstash; if (add && (PL_hints & HINT_STRICT_VARS) && - !(add & GV_ADDOUR) && sv_type != SVt_PVCV && sv_type != SVt_PVGV && sv_type != SVt_PVFM && @@ -141,4 +141,3 @@ HV *GvHVn(); #define GV_ADDWARN 0x04 /* add, but warn if symbol wasn't already there */ #define GV_ADDINEVAL 0x08 /* add, as though we're doing so within an eval */ #define GV_NOINIT 0x10 /* add, but don't init symbol, if type != PVGV */ -#define GV_ADDOUR 0x20 /* add "our" variable */ @@ -159,11 +159,15 @@ Perl_pad_allocmy(pTHX_ char *name) && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0) && strEQ(name, SvPVX(sv))) { - Perl_warner(aTHX_ WARN_UNSAFE, + if (PL_in_my != KEY_our + || GvSTASH(sv) == (PL_curstash ? PL_curstash : PL_defstash)) + { + Perl_warner(aTHX_ WARN_UNSAFE, "\"%s\" variable %s masks earlier declaration in same %s", (PL_in_my == KEY_our ? "our" : "my"), name, (SvIVX(sv) == PAD_MAX ? "scope" : "statement")); + } break; } } @@ -181,8 +185,11 @@ Perl_pad_allocmy(pTHX_ char *name) SvSTASH(sv) = (HV*)SvREFCNT_inc(PL_in_my_stash); PL_sv_objcount++; } - if (PL_in_my == KEY_our) + if (PL_in_my == KEY_our) { + (void)SvUPGRADE(sv, SVt_PVGV); + GvSTASH(sv) = (HV*)SvREFCNT_inc(PL_curstash ? PL_curstash : PL_defstash); SvFLAGS(sv) |= SVpad_OUR; + } av_store(PL_comppad_name, off, sv); SvNVX(sv) = (NV)PAD_MAX; SvIVX(sv) = 0; /* Not yet introduced--see newSTATEOP */ @@ -250,14 +257,17 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv, SvNVX(namesv) = (NV)PL_curcop->cop_seq; SvIVX(namesv) = PAD_MAX; /* A ref, intro immediately */ SvFAKE_on(namesv); /* A ref, not a real var */ - if (SvFLAGS(sv) & SVpad_OUR)/* An "our" variable */ - SvFLAGS(namesv) |= SVpad_OUR; if (SvOBJECT(sv)) { /* A typed var */ SvOBJECT_on(namesv); (void)SvUPGRADE(namesv, SVt_PVMG); SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)SvSTASH(sv)); PL_sv_objcount++; } + if (SvFLAGS(sv) & SVpad_OUR) { /* An "our" variable */ + SvFLAGS(namesv) |= SVpad_OUR; + (void)SvUPGRADE(namesv, SVt_PVGV); + GvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)GvSTASH(sv)); + } if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) { /* "It's closures all the way down." */ CvCLONE_on(PL_compcv); diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 4e38db25ca..d730b43e47 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -2788,6 +2788,34 @@ declared global variable without qualifying it with a package name. (But only within the lexical scope of the C<our> declaration. In this it differs from "use vars", which is package scoped.) +An C<our> declaration declares a global variable that will be visible +across its entire lexical scope, even across package boundaries. The +package in which the variable is entered is determined at the point +of the declaration, not at the point of use. This means the following +behavior holds: + + package Foo; + our $bar; # declares $Foo::bar for rest of lexical scope + $bar = 20; + + package Bar; + print $bar; # prints 20 + +Multiple C<our> declarations in the same lexical scope are allowed +if they are in different packages. If they happened to be in the same +package, Perl will emit warnings if you have asked for them. + + use warnings; + package Foo; + our $bar; # declares $Foo::bar for rest of lexical scope + $bar = 20; + + package Bar; + our $bar = 30; # declares $Bar::bar for rest of lexical scope + print $bar; # prints 30 + + our $bar; # emits warning + =item pack TEMPLATE,LIST Takes a LIST of values and converts it into a string using the rules @@ -7303,7 +7303,7 @@ do_clean_objs(pTHXo_ SV *sv) static void do_clean_named_objs(pTHXo_ SV *sv) { - if (SvTYPE(sv) == SVt_PVGV) { + if (SvTYPE(sv) == SVt_PVGV && GvGP(sv)) { if ( SvOBJECT(GvSV(sv)) || GvAV(sv) && SvOBJECT(GvAV(sv)) || GvHV(sv) && SvOBJECT(GvHV(sv)) || @@ -156,8 +156,7 @@ struct io { /* Some private flags. */ -#define SVpad_OUR 0x80000000 /* pad name is "our" instead of "my" */ - +/* SVpad_OUR may be set on SVt_PV{NV,MG,GV} types */ #define SVpad_OUR 0x80000000 /* pad name is "our" instead of "my" */ #define SVf_IVisUV 0x80000000 /* use XPVUV instead of XPVIV */ diff --git a/t/pragma/strict-vars b/t/pragma/strict-vars index b8108d278c..dc11f5d59e 100644 --- a/t/pragma/strict-vars +++ b/t/pragma/strict-vars @@ -307,3 +307,35 @@ print our $fred,"\n"; EXPECT 2 1 +######## + +# "nailed" our declaration visibility across package boundaries +use strict 'vars'; +our $foo; +$foo = 20; +package Foo; +print $foo, "\n"; +EXPECT +20 +######## + +# multiple our declarations in same scope, different packages, no warning +use strict 'vars'; +use warnings; +our $foo; +${foo} = 10; +package Foo; +our $foo = 20; +print $foo, "\n"; +EXPECT +20 +######## + +# multiple our declarations in same scope, same package, warning +use strict 'vars'; +use warnings; +our $foo; +${foo} = 10; +our $foo; +EXPECT +"our" variable $foo masks earlier declaration in same scope at - line 7. @@ -2015,15 +2015,19 @@ Perl_yylex(pTHX) } #endif /* USE_THREADS */ if ((tmp = pad_findmy(PL_tokenbuf)) != NOT_IN_PAD) { + SV *namesv = AvARRAY(PL_comppad_name)[tmp]; /* might be an "our" variable" */ - if (SvFLAGS(AvARRAY(PL_comppad_name)[tmp]) & SVpad_OUR) { + if (SvFLAGS(namesv) & SVpad_OUR) { /* build ops for a bareword */ - yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf+1, 0)); + SV *sym = newSVpv(HvNAME(GvSTASH(namesv)),0); + sv_catpvn(sym, "::", 2); + sv_catpv(sym, PL_tokenbuf+1); + yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym); yylval.opval->op_private = OPpCONST_ENTERED; - gv_fetchpv(PL_tokenbuf+1, + gv_fetchpv(SvPVX(sym), (PL_in_eval - ? (GV_ADDMULTI | GV_ADDINEVAL | GV_ADDOUR) - : GV_ADDOUR + ? (GV_ADDMULTI | GV_ADDINEVAL) + : TRUE ), ((PL_tokenbuf[0] == '$') ? SVt_PV : (PL_tokenbuf[0] == '@') ? SVt_PVAV |