POD fixes and nits in re.pm

[perl5.git] / op.c

diff --git a/op.c b/op.c
index fbe455e..5325a5a 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2118,8 +2118,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;
@@ -5342,7 +5342,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 +5370,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 +5453,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 +6754,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;
@@ -7375,6 +7375,10 @@ Perl_ck_subr(pTHX_ OP *o)
                optional = 1;
                proto++;
                continue;
+           case '_':
+               /* _ must be at the end */
+               if (proto[1] && proto[1] != ';')
+                   goto oops;
            case '$':
                proto++;
                arg++;
@@ -7534,8 +7538,14 @@ Perl_ck_subr(pTHX_ OP *o)
        prev = o2;
        o2 = o2->op_sibling;
     } /* while */
+    if (o2 == cvop && proto && *proto == '_') {
+       /* generate an access to $_ */
+       o2 = newDEFSVOP();
+       o2->op_sibling = prev->op_sibling;
+       prev->op_sibling = o2; /* instead of cvop */
+    }
     if (proto && !optional && proto_end > proto &&
-       (*proto != '@' && *proto != '%' && *proto != ';'))
+       (*proto != '@' && *proto != '%' && *proto != ';' && *proto != '_'))
        return too_few_arguments(o, gv_ename(namegv));
     if(delete_op) {
 #ifdef PERL_MAD