Make \N{ } deprecation warnings fatalizable

What drew my attention to this was the missing category in
perldiag.pod.  I tried adding it, but diag.t complained that it should
be absent.

It thinks it should be absent, because Perl_warn (when used correctly)
does not put the warning in any category, and does not allow it to be
suppressed except via $SIG{__WARN__}.

Use of if(ckWARN) followed by Perl_warn is not correct.  ckWARN checks
to see whether the category is enabled, and then Perl_warn warns with-
out reference to the category at all, so whether it is fatal cannot
be looked up.

The result is that these warnings do not die under ‘use warnings
FATAL => 'deprecated'’.

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 05a21a1..a2266dd 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -221,11 +221,11 @@ spots.  This is now heavily deprecated.
 
 =item A sequence of multiple spaces in a charnames alias definition is deprecated
 
-(D) You defined a character name which had multiple space characters in
-a row.  Change them to single spaces.  Usually these names are defined
-in the C<:alias> import argument to C<use charnames>, but they could be
-defined by a translator installed into C<$^H{charnames}>.  See
-L<charnames/CUSTOM ALIASES>.
+(D deprecated) You defined a character name which had multiple space
+characters in a row.  Change them to single spaces.  Usually these
+names are defined in the C<:alias> import argument to C<use charnames>, but
+they could be defined by a translator installed into C<$^H{charnames}>.
+See L<charnames/CUSTOM ALIASES>.
 
 =item assertion botched: %s
 
@@ -5187,10 +5187,10 @@ Backslash it.   See L<perlre>.
 
 =item Trailing white-space in a charnames alias definition is deprecated
 
-(D) You defined a character name which ended in a space character.
-Remove the trailing space(s).  Usually these names are defined in the
-C<:alias> import argument to C<use charnames>, but they could be defined
-by a translator installed into C<$^H{charnames}>.
+(D deprecated) You defined a character name which ended in a space
+character.  Remove the trailing space(s).  Usually these names are
+defined in the C<:alias> import argument to C<use charnames>, but they
+could be defined by a translator installed into C<$^H{charnames}>.
 See L<charnames/CUSTOM ALIASES>.
 
 =item Transliteration pattern not terminated

diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t
index 6012d2b..3440a32 100644 (file)
--- a/t/re/pat_advanced.t
+++ b/t/re/pat_advanced.t
@@ -1040,6 +1040,13 @@ sub run_tests {
             eval q [use utf8; "\N{TOO  MANY SPACES}"];
             ok (! defined $w, "... same under 'use utf8'");
         }
+        {
+            use warnings FATAL=> 'deprecated';
+            () = eval q ["\N{TOO  MANY SPACES}"];
+            like ($@, qr/A sequence of multiple spaces in a charnames alias definition is deprecated/, "... the deprecation warning can be fatal");
+            eval q [use utf8; () = "\N{TOO  MANY SPACES}"];
+            like ($@, qr/A sequence of multiple spaces in a charnames alias definition is deprecated/, "... same under utf8");
+        }
 
         undef $w;
         eval q [is("\N{TRAILING SPACE }", "TRAILING SPACE ", "Trailing space in character name works")];
@@ -1064,6 +1071,13 @@ sub run_tests {
             eval q [use utf8; "\N{TRAILING SPACE }"];
             ok (! defined $w, "... same under 'use utf8'");
         }
+        {
+            use warnings FATAL=>'deprecated';
+            () = eval q ["\N{TRAILING SPACE }"];
+            like ($@, qr/Trailing white-space in a charnames alias definition is deprecated/, "... the warning can be fatal");
+            eval q [use utf8; () = "\N{TRAILING SPACE }"];
+            like ($@, qr/Trailing white-space in a charnames alias definition is deprecated/, "... same under utf8");
+        }
 
         # If remove the limitation in regcomp code these should work
         # differently

diff --git a/toke.c b/toke.c
index 91c5a76..ba67bc6 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2729,12 +2729,16 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e)
                 goto bad_charname;
             }
            if (*s == ' ' && *(s-1) == ' ' && ckWARN_d(WARN_DEPRECATED)) {
-                Perl_warn(aTHX_ "A sequence of multiple spaces in a charnames alias definition is deprecated");
+                Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
+                           "A sequence of multiple spaces in a charnames "
+                           "alias definition is deprecated");
             }
             s++;
         }
         if (*(s-1) == ' ' && ckWARN_d(WARN_DEPRECATED)) {
-            Perl_warn(aTHX_ "Trailing white-space in a charnames alias definition is deprecated");
+            Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
+                        "Trailing white-space in a charnames alias "
+                        "definition is deprecated");
         }
     }
     else {
@@ -2773,7 +2777,9 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e)
                 }
                 if (*s == ' ' && *(s-1) == ' '
                  && ckWARN_d(WARN_DEPRECATED)) {
-                    Perl_warn(aTHX_ "A sequence of multiple spaces in a charnames alias definition is deprecated");
+                    Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
+                               "A sequence of multiple spaces in a charnam"
+                               "es alias definition is deprecated");
                 }
                 s++;
             }
@@ -2800,7 +2806,9 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e)
             }
         }
         if (*(s-1) == ' ' && ckWARN_d(WARN_DEPRECATED)) {
-            Perl_warn(aTHX_ "Trailing white-space in a charnames alias definition is deprecated");
+            Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
+                       "Trailing white-space in a charnames alias "
+                       "definition is deprecated");
         }
     }