stab at UNITCHECK blocks

[p5sagit/p5-mst-13.2.git] / op.c

diff --git a/op.c b/op.c
index 3dad488..66d3734 100644 (file)
--- a/op.c
+++ b/op.c
@@ -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();