X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=748888704c93069a5a85ef91e76a8fe457b63ad3;hb=2e5b50041f3643ca27385b211da60add40857ec8;hp=b88931960f10ba3fedab2539ebdf09bbc6babafb;hpb=99ab892b6470bcd28bad5512a942b608496ebf8f;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/op.c b/op.c
index b889319..7488887 100644
--- a/op.c
+++ b/op.c
@@ -399,14 +399,6 @@ Perl_allocmy(pTHX_ const char *const name)
     /* check for duplicate declaration */
     pad_check_dup(name, is_our, (PL_curstash ? PL_curstash : PL_defstash));
 
-    if (PL_parser->in_my_stash && *name != '$') {
-	yyerror(Perl_form(aTHX_
-		    "Can't declare class for non-scalar %s in \"%s\"",
- 		     name,
- 		     is_our ? "our"
-			    : PL_parser->in_my == KEY_state ? "state" : "my"));
-    }
-
     /* allocate a spare slot and store the name in that slot */
 
     off = pad_add_name(name,
@@ -4333,7 +4325,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 		      ((LISTOP*)right)->op_last->op_type == OP_CONST)
 		    {
 			SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv;
-			if (SvIVX(sv) == 0)
+			if (SvIOK(sv) && SvIVX(sv) == 0)
 			    sv_setiv(sv, PL_modcount+1);
 		    }
 		}
@@ -4355,6 +4347,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 	    PL_eval_start = 0;
 	else {
 	    if (!PL_madskills) { /* assignment to $[ is ignored when making a mad dump */
+		deprecate("assignment to $[");
 		op_free(o);
 		o = newSVOP(OP_CONST, 0, newSViv(CopARYBASE_get(&PL_compiling)));
 		o->op_private |= OPpCONST_ARYBASE;
@@ -5183,6 +5176,7 @@ S_looks_like_bool(pTHX_ const OP *o)
 
     switch(o->op_type) {
 	case OP_OR:
+	case OP_DOR:
 	    return looks_like_bool(cLOGOPo->op_first);
 
 	case OP_AND:
@@ -5198,7 +5192,6 @@ S_looks_like_bool(pTHX_ const OP *o)
 	case OP_ENTERSUB:
 
 	case OP_NOT:	case OP_XOR:
-	/* Note that OP_DOR is not here */
 
 	case OP_EQ:	case OP_NE:	case OP_LT:
 	case OP_GT:	case OP_LE:	case OP_GE:
@@ -5223,6 +5216,8 @@ S_looks_like_bool(pTHX_ const OP *o)
 	case OP_DEFINED: case OP_EXISTS:
 	case OP_MATCH:	 case OP_EOF:
 
+	case OP_FLOP:
+
 	    return TRUE;
 	
 	case OP_CONST:
@@ -5231,7 +5226,9 @@ S_looks_like_bool(pTHX_ const OP *o)
 	    ||  cSVOPo->op_sv == &PL_sv_no)
 	    
 		return TRUE;
-		
+	    else
+		return FALSE;
+
 	/* FALL THROUGH */
 	default:
 	    return FALSE;
@@ -5587,12 +5584,6 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 
     cv = (!name || GvCVGEN(gv)) ? NULL : GvCV(gv);
 
-#ifdef GV_UNIQUE_CHECK
-    if (cv && GvUNIQUE(gv) && SvREADONLY(cv)) {
-        Perl_croak(aTHX_ "Can't define subroutine %s (GV is unique)", name);
-    }
-#endif
-
     if (!block || !ps || *ps || attrs
 	|| (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS)
 #ifdef PERL_MAD
@@ -5606,12 +5597,6 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (cv) {
         const bool exists = CvROOT(cv) || CvXSUB(cv);
 
-#ifdef GV_UNIQUE_CHECK
-        if (exists && GvUNIQUE(gv)) {
-            Perl_croak(aTHX_ "Can't redefine unique subroutine %s", name);
-        }
-#endif
-
         /* if the subroutine doesn't exist and wasn't pre-declared
          * with a prototype, assume it will be AUTOLOADed,
          * skipping the prototype check
@@ -6154,20 +6139,19 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
 	? gv_fetchsv(cSVOPo->op_sv, GV_ADD, SVt_PVFM)
 	: gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVFM);
 
-#ifdef GV_UNIQUE_CHECK
-    if (GvUNIQUE(gv)) {
-        Perl_croak(aTHX_ "Bad symbol for form (GV is unique)");
-    }
-#endif
     GvMULTI_on(gv);
     if ((cv = GvFORM(gv))) {
 	if (ckWARN(WARN_REDEFINE)) {
 	    const line_t oldline = CopLINE(PL_curcop);
 	    if (PL_parser && PL_parser->copline != NOLINE)
 		CopLINE_set(PL_curcop, PL_parser->copline);
-	    Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
-			o ? "Format %"SVf" redefined"
-			: "Format STDOUT redefined", SVfARG(cSVOPo->op_sv));
+	    if (o) {
+		Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
+			    "Format %"SVf" redefined", SVfARG(cSVOPo->op_sv));
+	    } else {
+		Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
+			    "Format STDOUT redefined");
+	    }
 	    CopLINE_set(PL_curcop, oldline);
 	}
 	SvREFCNT_dec(cv);