X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=386e9de0bf981c5ded79f31ec3840bf194fc54b0;hb=2decb4fb82e001e3c9671c57b61232c651a9c22c;hp=0351b0ece4d228471213f42e4c7a1a31a2ba42be;hpb=7d4045d48787d5a77a81587f2bcaccfb05f3ff1e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/op.c b/op.c
index 0351b0e..386e9de 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,8 +257,11 @@ 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 */
+		    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 (SvOBJECT(sv)) {		/* A typed var */
 			SvOBJECT_on(namesv);
 			(void)SvUPGRADE(namesv, SVt_PVMG);
@@ -512,8 +522,12 @@ Perl_pad_free(pTHX_ PADOFFSET po)
     DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" free %"IVdf"\n",
 			  PTR2UV(PL_curpad), (IV)po));
 #endif /* USE_THREADS */
-    if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef)
+    if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
 	SvPADTMP_off(PL_curpad[po]);
+#ifdef USE_ITHREADS
+	SvREADONLY_off(PL_curpad[po]);	/* could be a freed constant */
+#endif
+    }
     if ((I32)po < PL_padix)
 	PL_padix = po - 1;
 }
@@ -1070,7 +1084,7 @@ Perl_scalarvoid(pTHX_ OP *o)
     case OP_RV2SV:
     case OP_RV2AV:
     case OP_RV2HV:
-	if (!(o->op_private & OPpLVAL_INTRO) &&
+	if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)) &&
 		(!o->op_sibling || o->op_sibling->op_type != OP_READLINE))
 	    useless = "a variable";
 	break;
@@ -1677,7 +1691,7 @@ Perl_ref(pTHX_ OP *o, I32 type)
 
     switch (o->op_type) {
     case OP_ENTERSUB:
-	if ((type == OP_DEFINED || type == OP_LOCK) &&
+	if ((type == OP_EXISTS || type == OP_DEFINED || type == OP_LOCK) &&
 	    !(o->op_flags & OPf_STACKED)) {
 	    o->op_type = OP_RV2CV;             /* entersub => rv2cv */
 	    o->op_ppaddr = PL_ppaddr[OP_RV2CV];
@@ -1826,6 +1840,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs)
     } else if (type == OP_RV2SV ||	/* "our" declaration */
 	       type == OP_RV2AV ||
 	       type == OP_RV2HV) { /* XXX does this let anything illegal in? */
+	o->op_private |= OPpOUR_INTRO;
 	return o;
     } else if (type != OP_PADSV &&
 	     type != OP_PADAV &&
@@ -4917,11 +4932,22 @@ Perl_ck_delete(pTHX_ OP *o)
     o->op_private = 0;
     if (o->op_flags & OPf_KIDS) {
 	OP *kid = cUNOPo->op_first;
-	if (kid->op_type == OP_HSLICE)
+	switch (kid->op_type) {
+	case OP_ASLICE:
+	    o->op_flags |= OPf_SPECIAL;
+	    /* FALL THROUGH */
+	case OP_HSLICE:
 	    o->op_private |= OPpSLICE;
-	else if (kid->op_type != OP_HELEM)
-	    Perl_croak(aTHX_ "%s argument is not a HASH element or slice",
+	    break;
+	case OP_AELEM:
+	    o->op_flags |= OPf_SPECIAL;
+	    /* FALL THROUGH */
+	case OP_HELEM:
+	    break;
+	default:
+	    Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element or slice",
 		  PL_op_desc[o->op_type]);
+	}
 	null(kid);
     }
     return o;
@@ -5007,8 +5033,18 @@ Perl_ck_exists(pTHX_ OP *o)
     o = ck_fun(o);
     if (o->op_flags & OPf_KIDS) {
 	OP *kid = cUNOPo->op_first;
-	if (kid->op_type != OP_HELEM)
-	    Perl_croak(aTHX_ "%s argument is not a HASH element", PL_op_desc[o->op_type]);
+	if (kid->op_type == OP_ENTERSUB) {
+	    (void) ref(kid, o->op_type);
+	    if (kid->op_type != OP_RV2CV && !PL_error_count)
+		Perl_croak(aTHX_ "%s argument is not a subroutine name",
+			   PL_op_desc[o->op_type]);
+	    o->op_private |= OPpEXISTS_SUB;
+	}
+	else if (kid->op_type == OP_AELEM)
+	    o->op_flags |= OPf_SPECIAL;
+	else if (kid->op_type != OP_HELEM)
+	    Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element",
+		       PL_op_desc[o->op_type]);
 	null(kid);
     }
     return o;