UNITCHECK for XS code. Turned out to be harder that expected.

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

diff --git a/op.c b/op.c
index 0bfd478..431c7a4 100644 (file)
--- a/op.c
+++ b/op.c
@@ -5634,7 +5634,7 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
        else
            s = name;
 
-       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")) {
@@ -5661,6 +5661,11 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
            Perl_av_create_and_unshift_one(aTHX_ &PL_checkav, (SV*)cv);
            GvCV(gv) = 0;               /* cv has been hijacked */
        }
+       else if (strEQ(s, "UNITCHECK")) {
+           /* It's never too late to run a unitcheck block */
+           Perl_av_create_and_unshift_one(aTHX_ &PL_unitcheckav, (SV*)cv);
+           GvCV(gv) = 0;               /* cv has been hijacked */
+       }
        else if (strEQ(s, "INIT")) {
            if (PL_main_start && ckWARN(WARN_VOID))
                Perl_warner(aTHX_ packWARN(WARN_VOID), "Too late to run INIT block");