merge perly.y and madlu.y

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 3dad488..ab84ef1 100644 (file)
--- a/op.c
+++ b/op.c
@@ -490,7 +490,19 @@ clear_pmop:
 STATIC void
 S_cop_free(pTHX_ COP* cop)
 {
-    Safefree(cop->cop_label);   /* FIXME: treaddead ??? */
+    if (cop->cop_label) {
+#ifdef PERL_TRACK_MEMPOOL
+       Malloc_t ptr = (Malloc_t)(cop->cop_label - sTHX);
+       struct perl_memory_debug_header *const header
+               = (struct perl_memory_debug_header *)ptr;
+       /* Only the thread that allocated us can free us. */
+       if (header->interpreter == aTHX)
+#endif
+       {
+           Safefree(cop->cop_label);
+           cop->cop_label = NULL;
+       }
+    }
     CopFILE_free(cop);
     CopSTASH_free(cop);
     if (! specialWARN(cop->cop_warnings))
@@ -1769,7 +1781,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
               type == OP_RV2AV ||
               type == OP_RV2HV) { /* XXX does this let anything illegal in? */
        if (cUNOPo->op_first->op_type != OP_GV) { /* MJD 20011224 */
-           yyerror(Perl_form(aTHX_ "Can't declare %s in %s",
+           yyerror(Perl_form(aTHX_ "Can't declare %s in \"%s\"",
                        OP_DESC(o),
                        PL_in_my == KEY_our ? "our" : PL_in_my == KEY_state ? "state" : "my"));
        } else if (attrs) {
@@ -2118,8 +2130,8 @@ Perl_fold_constants(pTHX_ register OP *o)
     dVAR;
     register OP *curop;
     OP *newop;
-    volatile I32 type = o->op_type;
-    volatile SV *sv = NULL;
+    VOL I32 type = o->op_type;
+    SV * VOL sv = NULL;
     int ret = 0;
     I32 oldscope;
     OP *old_next;
@@ -2995,6 +3007,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            bits = 8;
 
        Safefree(cPVOPo->op_pv);
+       cPVOPo->op_pv = NULL;
        cSVOPo->op_sv = (SV*)swash_init("utf8", "", listsv, bits, none);
        SvREFCNT_dec(listsv);
        SvREFCNT_dec(transv);
@@ -3314,7 +3327,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
        if (curop == repl
            && !(repl_has_vars
                 && (!PM_GETRE(pm)
-                    || PM_GETRE(pm)->reganch & ROPT_EVAL_SEEN))) {
+                    || PM_GETRE(pm)->extflags & RXf_EVAL_SEEN))) {
            pm->op_pmflags |= PMf_CONST;        /* const for long enough */
            pm->op_pmpermflags |= PMf_CONST;    /* const for long enough */
            prepend_elem(o->op_type, scalar(repl), o);
@@ -3989,10 +4002,13 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
     CopSTASH_set(cop, PL_curstash);
 
     if (PERLDB_LINE && PL_curstash != PL_debstash) {
-       SV * const * const svp = av_fetch(CopFILEAVx(PL_curcop), (I32)CopLINE(cop), FALSE);
-       if (svp && *svp != &PL_sv_undef ) {
-           (void)SvIOK_on(*svp);
-           SvIV_set(*svp, PTR2IV(cop));
+       AV *av = CopFILEAVx(PL_curcop);
+       if (av) {
+           SV * const * const svp = av_fetch(av, (I32)CopLINE(cop), FALSE);
+           if (svp && *svp != &PL_sv_undef ) {
+               (void)SvIOK_on(*svp);
+               SvIV_set(*svp, PTR2IV(cop));
+           }
        }
     }
 
@@ -4791,7 +4807,7 @@ Perl_cv_undef(pTHX_ CV *cv)
        /* for XSUBs CvFILE point directly to static memory; __FILE__ */
        Safefree(CvFILE(cv));
     }
-    CvFILE(cv) = 0;
+    CvFILE(cv) = NULL;
 #endif
 
     if (!CvISXSUB(cv) && CvROOT(cv)) {
@@ -5342,7 +5358,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        else
            s = tname;
 
-       if (*s != 'B' && *s != 'E' && *s != 'C' && *s != 'I')
+       if (*s != 'B' && *s != 'E' && *s != 'C' && *s != 'I' && *s != 'U')
            goto done;
 
        if (strEQ(s, "BEGIN") && !PL_error_count) {
@@ -5370,6 +5386,15 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            av_store(PL_endav, 0, (SV*)cv);
            GvCV(gv) = 0;               /* cv has been hijacked */
        }
+       else if (strEQ(s, "UNITCHECK") && !PL_error_count) {
+           /* It's never too late to run a unitcheck block */
+           if (!PL_unitcheckav)
+               PL_unitcheckav = newAV();
+           DEBUG_x( dump_sub(gv) );
+           av_unshift(PL_unitcheckav, 1);
+           av_store(PL_unitcheckav, 0, (SV*)cv);
+           GvCV(gv) = 0;               /* cv has been hijacked */
+       }
        else if (strEQ(s, "CHECK") && !PL_error_count) {
            if (!PL_checkav)
                PL_checkav = newAV();
@@ -5444,6 +5469,7 @@ Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv)
     cv = newXS_flags(name, const_sv_xsub, file, "", XS_DYNAMIC_FILENAME);
     CvXSUBANY(cv).any_ptr = sv;
     CvCONST_on(cv);
+    Safefree(file);
 
 #ifdef USE_ITHREADS
     if (stash)
@@ -6744,16 +6770,6 @@ Perl_ck_listiob(pTHX_ OP *o)
 }
 
 OP *
-Perl_ck_say(pTHX_ OP *o)
-{
-    o = ck_listiob(o);
-    o->op_type = OP_PRINT;
-    cLISTOPo->op_last = cLISTOPo->op_last->op_sibling
-       = newSVOP(OP_CONST, 0, newSVpvs("\n"));
-    return o;
-}
-
-OP *
 Perl_ck_smartmatch(pTHX_ OP *o)
 {
     dVAR;