This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make ‘SIG handler not defined’ UTF8- and null-safe
authorFather Chrysostomos <sprout@cpan.org>
Tue, 16 Sep 2014 03:34:32 +0000 (20:34 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 16 Sep 2014 04:45:12 +0000 (21:45 -0700)
mg.c
t/lib/warnings/mg

diff --git a/mg.c b/mg.c
index 01fa6b4..4ed7c7a 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -3124,11 +3124,17 @@ Perl_sighandler(int sig)
     }
 
     if (!cv || !CvROOT(cv)) {
-       Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL), "SIG%s handler \"%s\" not defined.\n",
-                      PL_sig_name[sig], (gv ? GvENAME(gv)
-                                         : ((cv && CvGV(cv))
-                                            ? GvENAME(CvGV(cv))
-                                            : "__ANON__")));
+       const HEK * const hek = gv
+                          ? GvENAME_HEK(gv)
+                          : cv && CvGV(cv) ? GvENAME_HEK(CvGV(cv)) : NULL;
+       if (hek)
+           Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL),
+                               "SIG%s handler \"%"HEKf"\" not defined.\n",
+                                PL_sig_name[sig], hek);
+            /* diag_listed_as: SIG%s handler "%s" not defined */
+       else Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL),
+                          "SIG%s handler \"__ANON__\" not defined.\n",
+                           PL_sig_name[sig]);
        goto cleanup;
     }
 
index 9e3652b..7eb8428 100644 (file)
@@ -44,6 +44,29 @@ EXPECT
 
 ########
 # mg.c
+use warnings 'signal' ;
+if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') {
+    print "SKIPPED\n# $^O, can't kill() to raise()\n"; exit;
+}
+$|=1;
+$SIG{__WARN__} = sub { warn shift =~ s/\0/\\0/rugs };
+$SIG{"INT"} = "fr\0d"; kill "INT",$$;
+EXPECT
+SIGINT handler "fr\0d" not defined.
+########
+# mg.c
+use warnings 'signal' ;
+use open ":std", ":utf8";
+use utf8;
+if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') {
+    print "SKIPPED\n# $^O, can't kill() to raise()\n"; exit;
+}
+$|=1;
+$SIG{"INT"} = "프레드"; kill "INT",$$;
+EXPECT
+SIGINT handler "프레드" not defined.
+########
+# mg.c
 use warnings 'uninitialized';
 'foo' =~ /(foo)/;
 oct $3;