whichsig nul-cleanup.

This adds _pv, _pvn, and _pv versions of whichsig() in mg.c, which
get both kill "NAME" and %SIG lookup nul-clean.

diff --git a/MANIFEST b/MANIFEST
index f98a0d2..2e1312c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3870,6 +3870,7 @@ ext/XS-APItest/t/temp_lv_sub.t    XS::APItest: tests for lvalue subs returning temp
 ext/XS-APItest/t/underscore_length.t   Test find_rundefsv()
 ext/XS-APItest/t/utf16_to_utf8.t       Test behaviour of utf16_to_utf8{,reversed}
 ext/XS-APItest/t/utf8.t                Tests for code in utf8.c
+ext/XS-APItest/t/whichsig.t    XS::APItest: tests for whichsig() and variants
 ext/XS-APItest/t/xs_special_subs_require.t     for require too
 ext/XS-APItest/t/xs_special_subs.t     Test that XS BEGIN/CHECK/INIT/END work
 ext/XS-APItest/t/xsub_h.t      Tests for XSUB.h

diff --git a/doio.c b/doio.c
index 9d06cbe..b86eac4 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1567,6 +1567,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
     register I32 tot = 0;
     const char *const what = PL_op_name[type];
     const char *s;
+    STRLEN len;
     SV ** const oldmark = mark;
 
     PERL_ARGS_ASSERT_APPLY;
@@ -1677,12 +1678,14 @@ nothing in the core.
        APPLY_TAINT_PROPER();
        if (mark == sp)
            break;
-       s = SvPVx_nolen_const(*++mark);
+       s = SvPVx_const(*++mark, len);
        if (isALPHA(*s)) {
-           if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
+           if (*s == 'S' && s[1] == 'I' && s[2] == 'G') {
                s += 3;
-           if ((val = whichsig(s)) < 0)
-               Perl_croak(aTHX_ "Unrecognized signal name \"%s\"",s);
+                len -= 3;
+            }
+           if ((val = whichsig_pvn(s, len)) < 0)
+               Perl_croak(aTHX_ "Unrecognized signal name \"%"SVf"\"", SVfARG(*mark));
        }
        else
            val = SvIV(*mark);

diff --git a/embed.fnc b/embed.fnc
index 362375e..d29cabc 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1454,7 +1454,9 @@ Afp       |void   |ck_warner_d    |U32 err|NN const char* pat|...
 Ap     |void   |vwarner        |U32 err|NN const char* pat|NULLOK va_list* args
 : FIXME
 p      |void   |watch          |NN char** addr
-Ap     |I32    |whichsig       |NN const char* sig
+Ap     |I32    |whichsig_sv    |NN SV* sigsv
+Ap     |I32    |whichsig_pv    |NN const char* sig
+Ap     |I32    |whichsig_pvn   |NN const char* sig|STRLEN len
 : Used in pp_ctl.c
 p      |void   |write_to_stderr|NN SV* msv
 : Used in op.c

diff --git a/embed.h b/embed.h
index 41c359c..4c7cbe5 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -695,7 +695,9 @@
 #ifndef PERL_IMPLICIT_CONTEXT
 #define warner                 Perl_warner
 #endif
-#define whichsig(a)            Perl_whichsig(aTHX_ a)
+#define whichsig_pv(a)         Perl_whichsig_pv(aTHX_ a)
+#define whichsig_pvn(a,b)      Perl_whichsig_pvn(aTHX_ a,b)
+#define whichsig_sv(a)         Perl_whichsig_sv(aTHX_ a)
 #if !(defined(HAS_SIGACTION) && defined(SA_SIGINFO))
 #define csighandler            Perl_csighandler
 #endif

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index b9049e5..0f09c3a 100644 (file)
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -2003,6 +2003,31 @@ gv_autoload_type(stash, methname, type, method)
        XPUSHs( gv ? (SV*)gv : &PL_sv_undef);
 
 void
+whichsig_type(namesv, type)
+    SV* namesv
+    int type
+    PREINIT:
+        STRLEN len;
+        const char * const name = SvPV_const(namesv, len);
+        I32 i;
+    PPCODE:
+        switch (type) {
+           case 0:
+              i = whichsig(name);
+               break;
+           case 1:
+               i = whichsig_sv(namesv);
+               break;
+           case 2:
+               i = whichsig_pv(name);
+               break;
+           case 3:
+               i = whichsig_pvn(name, len);
+               break;
+        }
+        XPUSHs(sv_2mortal(newSViv(i)));
+
+void
 eval_sv(sv, flags)
     SV* sv
     I32 flags

diff --git a/ext/XS-APItest/t/whichsig.t b/ext/XS-APItest/t/whichsig.t
new file mode 100644 (file)
index 0000000..e87ba98
--- /dev/null
+++ b/ext/XS-APItest/t/whichsig.t
@@ -0,0 +1,26 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 9;
+
+use_ok('XS::APItest');
+
+my @types = map { 'whichsig' . $_ } '', qw( _sv _pv _pvn );
+
+sub test { "Sanity check" }
+
+{
+    for my $type ( 0..3 ) {
+        is XS::APItest::whichsig_type("KILL", $type), 9, "Sanity check, $types[$type] works";
+    }
+}
+
+is XS::APItest::whichsig_type("KILL\0whoops", 0), 9, "whichsig() is not nul-clean";
+
+is XS::APItest::whichsig_type("KILL\0whoops", 1), -1, "whichsig_sv() is nul-clean";
+
+is XS::APItest::whichsig_type("KILL\0whoops", 2), 9, "whichsig_pv() is not nul-clean";
+
+is XS::APItest::whichsig_type("KILL\0whoops", 3), -1, "whichsig_pvn() is nul-clean";

diff --git a/mg.c b/mg.c
index 232db2c..1b24ce8 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1302,7 +1302,9 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
     PERL_ARGS_ASSERT_MAGIC_GETSIG;
 
     if (!i) {
-       mg->mg_private = i = whichsig(MgPV_nolen_const(mg));
+        STRLEN siglen;
+        const char * sig = MgPV_const(mg, siglen);
+        mg->mg_private = i = whichsig_pvn(sig, siglen);
     }
 
     if (i > 0) {
@@ -1493,9 +1495,9 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
     PERL_ARGS_ASSERT_MAGIC_SETSIG;
 
     if (*s == '_') {
-       if (strEQ(s,"__DIE__"))
+        if (memEQs(s, len, "__DIE__"))
            svp = &PL_diehook;
-       else if (strEQ(s,"__WARN__")
+       else if (memEQs(s, len, "__WARN__")
                 && (sv ? 1 : PL_warnhook != PERL_WARNHOOK_FATAL)) {
            /* Merge the existing behaviours, which are as follows:
               magic_setsig, we always set svp to &PL_warnhook
@@ -1503,8 +1505,11 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
               For magic_clearsig, we don't change the warnings handler if it's
               set to the &PL_warnhook.  */
            svp = &PL_warnhook;
-       } else if (sv)
-           Perl_croak(aTHX_ "No such hook: %s", s);
+        } else if (sv) {
+            SV *tmp = sv_newmortal();
+            Perl_croak(aTHX_ "No such hook: %s",
+                                pv_pretty(tmp, s, len, 0, NULL, NULL, 0));
+        }
        i = 0;
        if (svp && *svp) {
            if (*svp != PERL_WARNHOOK_FATAL)
@@ -1515,12 +1520,15 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
     else {
        i = (I16)mg->mg_private;
        if (!i) {
-           i = whichsig(s);    /* ...no, a brick */
+           i = whichsig_pvn(s, len);   /* ...no, a brick */
            mg->mg_private = (U16)i;
        }
        if (i <= 0) {
-           if (sv)
-               Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL), "No such signal: SIG%s", s);
+           if (sv) {
+                SV *tmp = sv_newmortal();
+               Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL), "No such signal: SIG%s",
+                                            pv_pretty(tmp, s, len, 0, NULL, NULL, 0));
+            }
            return 0;
        }
 #ifdef HAS_SIGPROCMASK
@@ -1576,7 +1584,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
        } else {
            sv = NULL;
        }
-       if (sv && strEQ(s,"IGNORE")) {
+       if (sv && memEQs(s, len,"IGNORE")) {
            if (i) {
 #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
                PL_sig_ignoring[i] = 1;
@@ -1586,7 +1594,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 #endif
            }
        }
-       else if (!sv || strEQ(s,"DEFAULT") || !len) {
+       else if (!sv || memEQs(s, len,"DEFAULT") || !len) {
            if (i) {
 #ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
                PL_sig_defaulting[i] = 1;
@@ -2981,22 +2989,41 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 }
 
 I32
-Perl_whichsig(pTHX_ const char *sig)
+Perl_whichsig_sv(pTHX_ SV *sigsv)
+{
+    const char *sigpv;
+    STRLEN siglen;
+    PERL_ARGS_ASSERT_WHICHSIG_SV;
+    PERL_UNUSED_CONTEXT;
+    sigpv = SvPV_const(sigsv, siglen);
+    return whichsig_pvn(sigpv, siglen);
+}
+
+I32
+Perl_whichsig_pv(pTHX_ const char *sig)
+{
+    PERL_ARGS_ASSERT_WHICHSIG_PV;
+    PERL_UNUSED_CONTEXT;
+    return whichsig_pvn(sig, strlen(sig));
+}
+
+I32
+Perl_whichsig_pvn(pTHX_ const char *sig, STRLEN len)
 {
     register char* const* sigv;
 
-    PERL_ARGS_ASSERT_WHICHSIG;
+    PERL_ARGS_ASSERT_WHICHSIG_PVN;
     PERL_UNUSED_CONTEXT;
 
     for (sigv = (char* const*)PL_sig_name; *sigv; sigv++)
-       if (strEQ(sig,*sigv))
+       if (strlen(*sigv) == len && memEQ(sig,*sigv, len))
            return PL_sig_num[sigv - (char* const*)PL_sig_name];
 #ifdef SIGCLD
-    if (strEQ(sig,"CHLD"))
+    if (memEQs(sig, len, "CHLD"))
        return SIGCLD;
 #endif
 #ifdef SIGCHLD
-    if (strEQ(sig,"CLD"))
+    if (memEQs(sig, len, "CLD"))
        return SIGCHLD;
 #endif
     return -1;

diff --git a/mg.h b/mg.h
index 848f735..53ef628 100644 (file)
--- a/mg.h
+++ b/mg.h
@@ -61,6 +61,8 @@ struct magic {
 #define SvTIED_obj(sv,mg) \
     ((mg)->mg_obj ? (mg)->mg_obj : sv_2mortal(newRV(sv)))
 
+#define whichsig(pv) whichsig_pv(pv)
+
 /*
  * Local variables:
  * c-indentation-style: bsd

diff --git a/proto.h b/proto.h
index ba793bf..2590175 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -4643,11 +4643,21 @@ PERL_CALLCONV void      Perl_watch(pTHX_ char** addr)
 #define PERL_ARGS_ASSERT_WATCH \
        assert(addr)
 
-PERL_CALLCONV I32      Perl_whichsig(pTHX_ const char* sig)
+PERL_CALLCONV I32      Perl_whichsig_pv(pTHX_ const char* sig)
                        __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_WHICHSIG      \
+#define PERL_ARGS_ASSERT_WHICHSIG_PV   \
        assert(sig)
 
+PERL_CALLCONV I32      Perl_whichsig_pvn(pTHX_ const char* sig, STRLEN len)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_WHICHSIG_PVN  \
+       assert(sig)
+
+PERL_CALLCONV I32      Perl_whichsig_sv(pTHX_ SV* sigsv)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_WHICHSIG_SV   \
+       assert(sigsv)
+
 PERL_CALLCONV void     Perl_write_to_stderr(pTHX_ SV* msv)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_WRITE_TO_STDERR       \

diff --git a/t/op/sigdispatch.t b/t/op/sigdispatch.t
index 6b8c778..3b8d6ec 100644 (file)
--- a/t/op/sigdispatch.t
+++ b/t/op/sigdispatch.t
@@ -9,7 +9,7 @@ BEGIN {
 use strict;
 use Config;
 
-plan tests => 23;
+plan tests => 26;
 
 watchdog(15);
 
@@ -122,3 +122,18 @@ SKIP: {
     alarm(0);
     is($@, "HANDLER CALLED\n", 'string eval');
 }
+
+eval { $SIG{"__WARN__\0"} = sub { 1 } };
+like $@, qr/No such hook: __WARN__\\0 at/, q!Fetching %SIG hooks with an extra trailing nul is nul-clean!;
+
+eval { $SIG{"__DIE__\0whoops"} = sub { 1 } };
+like $@, qr/No such hook: __DIE__\\0whoops at/;
+
+{
+    use warnings;
+    my $w;
+    local $SIG{__WARN__} = sub { $w = shift };
+
+    $SIG{"KILL\0"} = sub { 1 };
+    like $w, qr/No such signal: SIGKILL\\0 at/, 'Arbitrary signal lookup through %SIG is clean';
+}