nailed "our" declarations, and better warnings on duplicate

"our" declarations

p4raw-id: //depot/perl@4801

9 files changed, 87 insertions, 14 deletions

diff --git a/dump.c b/dump.c
index c10ac1abc7..ee64af5b89 100644
--- a/dump.c
+++ b/dump.c
@@ -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)));
diff --git a/gv.c b/gv.c
index 30d8f1e1e2..0305ad5f4a 100644
--- a/gv.c
+++ b/gv.c
@@ -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 &&
diff --git a/gv.h b/gv.h
index f00331aed0..f489d2d50b 100644
--- a/gv.h
+++ b/gv.h
@@ -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 */
diff --git a/op.c b/op.c
index 3c92fefe91..b07a1fbed3 100644
--- a/op.c
+++ b/op.c
@@ -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
diff --git a/sv.c b/sv.c
index ca25b063ba..0b838a1a16 100644
--- a/sv.c
+++ b/sv.c
@@ -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)) ||
diff --git a/sv.h b/sv.h
index b6e819fff6..4505d60cca 100644
--- a/sv.h
+++ b/sv.h
@@ -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.
diff --git a/toke.c b/toke.c
index f35a0421f3..a38f58f9d2 100644
--- a/toke.c
+++ b/toke.c
@@ -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