X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=949d8f427e35df865961724eef159b6f2cb53ecf;hb=345dbb93fc4813c4387eb6b1eedefc6d79a752d0;hp=08f1689255cb9369d174e8812c9daa62d0b76fbb;hpb=66610fdd5da795f6de595e815ccc4d1c9f3f4505;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/op.c b/op.c
index 08f1689..949d8f4 100644
--- a/op.c
+++ b/op.c
@@ -407,18 +407,21 @@ clear_pmop:
 	{
 	    HV *pmstash = PmopSTASH(cPMOPo);
 	    if (pmstash && SvREFCNT(pmstash)) {
-		PMOP *pmop = HvPMROOT(pmstash);
-		PMOP *lastpmop = NULL;
-		while (pmop) {
-		    if (cPMOPo == pmop) {
-			if (lastpmop)
-			    lastpmop->op_pmnext = pmop->op_pmnext;
-			else
-			    HvPMROOT(pmstash) = pmop->op_pmnext;
-			break;
+		MAGIC *mg = mg_find((SV*)pmstash, PERL_MAGIC_symtab);
+		if (mg) {
+		    PMOP *pmop = (PMOP*) mg->mg_obj;
+		    PMOP *lastpmop = NULL;
+		    while (pmop) {
+			if (cPMOPo == pmop) {
+			    if (lastpmop)
+				lastpmop->op_pmnext = pmop->op_pmnext;
+			    else
+				mg->mg_obj = (SV*) pmop->op_pmnext;
+			    break;
+			}
+			lastpmop = pmop;
+			pmop = pmop->op_pmnext;
 		    }
-		    lastpmop = pmop;
-		    pmop = pmop->op_pmnext;
 		}
 	    }
 	    PmopSTASH_free(cPMOPo);
@@ -782,9 +785,9 @@ Perl_scalarvoid(pTHX_ OP *o)
                      built upon these three nroff macros being used in
                      void context. The pink camel has the details in
                      the script wrapman near page 319. */
-		    if (strnEQ(SvPVX(sv), "di", 2) ||
-			strnEQ(SvPVX(sv), "ds", 2) ||
-			strnEQ(SvPVX(sv), "ig", 2))
+		    if (strnEQ(SvPVX_const(sv), "di", 2) ||
+			strnEQ(SvPVX_const(sv), "ds", 2) ||
+			strnEQ(SvPVX_const(sv), "ig", 2))
 			    useless = 0;
 		}
 	    }
@@ -1376,12 +1379,12 @@ S_scalar_mod_type(pTHX_ const OP *o, I32 type)
 }
 
 STATIC bool
-S_is_handle_constructor(pTHX_ const OP *o, I32 argnum)
+S_is_handle_constructor(pTHX_ const OP *o, I32 numargs)
 {
     switch (o->op_type) {
     case OP_PIPE_OP:
     case OP_SOCKPAIR:
-	if (argnum == 2)
+	if (numargs == 2)
 	    return TRUE;
 	/* FALL THROUGH */
     case OP_SYSOPEN:
@@ -1390,7 +1393,7 @@ S_is_handle_constructor(pTHX_ const OP *o, I32 argnum)
     case OP_SOCKET:
     case OP_OPEN_DIR:
     case OP_ACCEPT:
-	if (argnum == 1)
+	if (numargs == 1)
 	    return TRUE;
 	/* FALL THROUGH */
     default:
@@ -1532,7 +1535,7 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my)
     ENTER;		/* need to protect against side-effects of 'use' */
     SAVEINT(PL_expect);
     if (stash)
-	stashsv = newSVpv(HvNAME(stash), 0);
+	stashsv = newSVpvn(HvNAME_get(stash), HvNAMELEN_get(stash));
     else
 	stashsv = &PL_sv_no;
 
@@ -1540,9 +1543,8 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my)
 #define ATTRSMODULE_PM "attributes.pm"
 
     if (for_my) {
-	SV **svp;
 	/* Don't force the C<use> if we don't need it. */
-	svp = hv_fetch(GvHVn(PL_incgv), ATTRSMODULE_PM,
+	SV **svp = hv_fetch(GvHVn(PL_incgv), ATTRSMODULE_PM,
 		       sizeof(ATTRSMODULE_PM)-1, 0);
 	if (svp && *svp != &PL_sv_undef)
 	    ; 		/* already in %INC */
@@ -1586,7 +1588,7 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp)
 
     /* Build up the real arg-list. */
     if (stash)
-	stashsv = newSVpv(HvNAME(stash), 0);
+	stashsv = newSVpvn(HvNAME_get(stash), HvNAMELEN_get(stash));
     else
 	stashsv = &PL_sv_no;
     arg = newOP(OP_PADSV, 0);
@@ -1604,7 +1606,7 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp)
     (void)SvIOK_on(meth);
     {
 	U32 hash;
-	PERL_HASH(hash, SvPVX(meth), SvCUR(meth));
+	PERL_HASH(hash, SvPVX_const(meth), SvCUR(meth));
 	SvUV_set(meth, hash);
     }
     imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL|OPf_WANT_VOID,
@@ -2366,9 +2368,8 @@ Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
     return fold_constants((OP *)binop);
 }
 
-static int uvcompare(const void *a, const void *b) __attribute__((nonnull,pure));
-static int
-uvcompare(const void *a, const void *b)
+static int uvcompare(const void *a, const void *b) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__pure__;
+static int uvcompare(const void *a, const void *b)
 {
     if (*((const UV *)a) < (*(const UV *)b))
 	return -1;
@@ -2725,8 +2726,13 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
 
         /* link into pm list */
     if (type != OP_TRANS && PL_curstash) {
-	pmop->op_pmnext = HvPMROOT(PL_curstash);
-	HvPMROOT(PL_curstash) = pmop;
+	MAGIC *mg = mg_find((SV*)PL_curstash, PERL_MAGIC_symtab);
+
+	if (!mg) {
+	    mg = sv_magicext((SV*)PL_curstash, 0, PERL_MAGIC_symtab, 0, 0, 0);
+	}
+	pmop->op_pmnext = (PMOP*)mg->mg_obj;
+	mg->mg_obj = (SV*)pmop;
 	PmopSTASH_set(pmop,PL_curstash);
     }
 
@@ -3039,7 +3045,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
 	    (void)SvIOK_on(meth);
 	    {
 		U32 hash;
-		PERL_HASH(hash, SvPVX(meth), SvCUR(meth));
+		PERL_HASH(hash, SvPVX_const(meth), SvCUR(meth));
 		SvUV_set(meth, hash);
 	    }
 	    veop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
@@ -3067,7 +3073,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
 	(void)SvIOK_on(meth);
 	{
 	    U32 hash;
-	    PERL_HASH(hash, SvPVX(meth), SvCUR(meth));
+	    PERL_HASH(hash, SvPVX_const(meth), SvCUR(meth));
 	    SvUV_set(meth, hash);
 	}
 	imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
@@ -3219,7 +3225,7 @@ Perl_newSLICEOP(pTHX_ I32 flags, OP *subscript, OP *listval)
 }
 
 STATIC I32
-S_list_assignment(pTHX_ register const OP *o)
+S_is_list_assignment(pTHX_ register const OP *o)
 {
     if (!o)
 	return TRUE;
@@ -3228,8 +3234,8 @@ S_list_assignment(pTHX_ register const OP *o)
 	o = cUNOPo->op_first;
 
     if (o->op_type == OP_COND_EXPR) {
-        const I32 t = list_assignment(cLOGOPo->op_first->op_sibling);
-        const I32 f = list_assignment(cLOGOPo->op_first->op_sibling->op_sibling);
+        const I32 t = is_list_assignment(cLOGOPo->op_first->op_sibling);
+        const I32 f = is_list_assignment(cLOGOPo->op_first->op_sibling->op_sibling);
 
 	if (t && f)
 	    return TRUE;
@@ -3274,7 +3280,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 	}
     }
 
-    if (list_assignment(left)) {
+    if (is_list_assignment(left)) {
 	OP *curop;
 
 	PL_modcount = 0;
@@ -4056,6 +4062,7 @@ Perl_cv_undef(pTHX_ CV *cv)
 
 	op_free(CvROOT(cv));
 	CvROOT(cv) = Nullop;
+	CvSTART(cv) = Nullop;
 	LEAVE;
     }
     SvPOK_off((SV*)cv);		/* forget prototype */
@@ -4083,7 +4090,7 @@ Perl_cv_undef(pTHX_ CV *cv)
 void
 Perl_cv_ckproto(pTHX_ const CV *cv, const GV *gv, const char *p)
 {
-    if (((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) && ckWARN_d(WARN_PROTOTYPE)) {
+    if (((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX_const(cv)))) && ckWARN_d(WARN_PROTOTYPE)) {
 	SV* msg = sv_newmortal();
 	SV* name = Nullsv;
 
@@ -4252,7 +4259,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	Perl_sv_setpvf(aTHX_ sv, "%s[%s:%"IVdf"]",
 		       PL_curstash ? "__ANON__" : "__ANON__::__ANON__",
 		       CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
-	aname = SvPVX(sv);
+	aname = SvPVX_const(sv);
     }
     else
 	aname = Nullch;
@@ -4502,9 +4509,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 			   CopFILE(PL_curcop),
 			   (long)PL_subline, (long)CopLINE(PL_curcop));
 	    gv_efullname3(tmpstr, gv, Nullch);
-	    hv_store(GvHV(PL_DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
+	    hv_store(GvHV(PL_DBsub), SvPVX_const(tmpstr), SvCUR(tmpstr), sv, 0);
 	    hv = GvHVn(db_postponed);
-	    if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr))
+	    if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX_const(tmpstr), SvCUR(tmpstr))
 		&& (pcv = GvCV(db_postponed)))
 	    {
 		dSP;
@@ -4646,8 +4653,9 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
 	}
 	else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
 	    /* already defined (or promised) */
+	    /* XXX It's possible for this HvNAME_get to return null, and get passed into strEQ */
 	    if (ckWARN(WARN_REDEFINE) && !(CvGV(cv) && GvSTASH(CvGV(cv))
-			    && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
+			    && strEQ(HvNAME_get(GvSTASH(CvGV(cv))), "autouse"))) {
 		const line_t oldline = CopLINE(PL_curcop);
 		if (PL_copline != NOLINE)
 		    CopLINE_set(PL_curcop, PL_copline);
@@ -4900,11 +4908,7 @@ Perl_oopsCV(pTHX_ OP *o)
     Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__);
     /* STUB */
     (void)o;
-#ifndef HASATTRIBUTE
-    /* No __attribute__, so the compiler doesn't know that croak never returns
-     */
-    return 0;
-#endif
+    NORETURN_FUNCTION_END;
 }
 
 OP *
@@ -4957,8 +4961,8 @@ Perl_ck_bitop(pTHX_ OP *o)
 	     || o->op_type == OP_BIT_AND
 	     || o->op_type == OP_BIT_XOR))
     {
-	const OP * left = cBINOPo->op_first;
-	const OP * right = left->op_sibling;
+	const OP * const left = cBINOPo->op_first;
+	const OP * const right = left->op_sibling;
 	if ((OP_IS_NUMCOMPARE(left->op_type) &&
 		(left->op_flags & OPf_PARENS) == 0) ||
 	    (OP_IS_NUMCOMPARE(right->op_type) &&
@@ -5159,17 +5163,6 @@ Perl_ck_exists(pTHX_ OP *o)
     return o;
 }
 
-#if 0
-OP *
-Perl_ck_gvconst(pTHX_ register OP *o)
-{
-    o = fold_constants(o);
-    if (o->op_type == OP_CONST)
-	o->op_type = OP_GV;
-    return o;
-}
-#endif
-
 OP *
 Perl_ck_rvconst(pTHX_ register OP *o)
 {
@@ -5180,12 +5173,12 @@ Perl_ck_rvconst(pTHX_ register OP *o)
     if (kid->op_type == OP_CONST) {
 	int iscv;
 	GV *gv;
-	SV *kidsv = kid->op_sv;
+	SV * const kidsv = kid->op_sv;
 
 	/* Is it a constant from cv_const_sv()? */
 	if (SvROK(kidsv) && SvREADONLY(kidsv)) {
 	    SV *rsv = SvRV(kidsv);
-	    int svtype = SvTYPE(rsv);
+	    const int svtype = SvTYPE(rsv);
             const char *badtype = Nullch;
 
 	    switch (o->op_type) {
@@ -5838,10 +5831,10 @@ Perl_ck_method(pTHX_ OP *o)
     OP *kid = cUNOPo->op_first;
     if (kid->op_type == OP_CONST) {
 	SV* sv = kSVOP->op_sv;
-	if (!(strchr(SvPVX(sv), ':') || strchr(SvPVX(sv), '\''))) {
+	if (!(strchr(SvPVX_const(sv), ':') || strchr(SvPVX_const(sv), '\''))) {
 	    OP *cmop;
 	    if (!SvREADONLY(sv) || !SvFAKE(sv)) {
-		sv = newSVpvn_share(SvPVX(sv), SvCUR(sv), 0);
+		sv = newSVpvn_share(SvPVX_const(sv), SvCUR(sv), 0);
 	    }
 	    else {
 		kSVOP->op_sv = Nullsv;
@@ -5893,7 +5886,7 @@ Perl_ck_open(pTHX_ OP *o)
 	 OP *first = cLISTOPx(o)->op_first; /* The pushmark. */
 	 OP *last  = cLISTOPx(o)->op_last;  /* The bareword. */
 	 OP *oa;
-	 char *mode;
+	 const char *mode;
 
 	 if ((last->op_type == OP_CONST) &&		/* The bareword. */
 	     (last->op_private & OPpCONST_BARE) &&
@@ -5901,7 +5894,7 @@ Perl_ck_open(pTHX_ OP *o)
 	     (oa = first->op_sibling) &&		/* The fh. */
 	     (oa = oa->op_sibling) &&			/* The mode. */
 	     SvPOK(((SVOP*)oa)->op_sv) &&
-	     (mode = SvPVX(((SVOP*)oa)->op_sv)) &&
+	     (mode = SvPVX_const(((SVOP*)oa)->op_sv)) &&
 	     mode[0] == '>' && mode[1] == '&' &&	/* A dup open. */
 	     (last == oa->op_sibling))			/* The bareword. */
 	      last->op_private &= ~OPpCONST_STRICT;
@@ -6676,7 +6669,7 @@ Perl_peep(pTHX_ register OP *o)
 	    }
 	    else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_PROTOTYPE)) {
 		GV *gv = cGVOPo_gv;
-		if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX(GvCV(gv))) {
+		if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX_const(GvCV(gv))) {
 		    /* XXX could check prototype here instead of just carping */
 		    SV *sv = sv_newmortal();
 		    gv_efullname3(sv, gv, Nullch);
@@ -6802,7 +6795,7 @@ Perl_peep(pTHX_ register OP *o)
 	    {
 		Perl_croak(aTHX_ "No such class field \"%s\" " 
 			   "in variable %s of type %s", 
-		      key, SvPV_nolen(lexname), HvNAME(SvSTASH(lexname)));
+		      key, SvPV_nolen(lexname), HvNAME_get(SvSTASH(lexname)));
 	    }
 
             break;
@@ -6859,7 +6852,7 @@ Perl_peep(pTHX_ register OP *o)
 		{
 		    Perl_croak(aTHX_ "No such class field \"%s\" "
 			       "in variable %s of type %s",
-			  key, SvPV_nolen(lexname), HvNAME(SvSTASH(lexname)));
+			  key, SvPV_nolen(lexname), HvNAME_get(SvSTASH(lexname)));
 		}
 	    }
 	    break;
@@ -7131,7 +7124,7 @@ const_sv_xsub(pTHX_ CV* cv)
     if (items != 0) {
 #if 0
         Perl_croak(aTHX_ "usage: %s::%s()",
-                   HvNAME(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv)));
+                   HvNAME_get(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv)));
 #endif
     }
     EXTEND(sp, 1);
@@ -7146,5 +7139,5 @@ const_sv_xsub(pTHX_ CV* cv)
  * indent-tabs-mode: t
  * End:
  *
- * vim: ts=8 sts=4 sw=4 noet:
-*/
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */