patch to add DEL to [:cntrl:]

Message-Id: <200107140625.XAA01517@ventrue.corp.yahoo.com>

p4raw-id: //depot/perl@11371

diff --git a/handy.h b/handy.h
index 9fd6de8..c7bdf3c 100644 (file)
--- a/handy.h
+++ b/handy.h
@@ -341,7 +341,7 @@ Converts the specified character to lowercase.
 #   define isLOWER(c)  ((c) >= 'a' && (c) <= 'z')
 #   define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
 #   define isASCII(c)  ((c) <= 127)
-#   define isCNTRL(c)  ((c) < ' ')
+#   define isCNTRL(c)  ((c) < ' ' || (c) == 127)
 #   define isGRAPH(c)  (isALNUM(c) || isPUNCT(c))
 #   define isPRINT(c)  (((c) > 32 && (c) < 127) || (c) == ' ')
 #   define isPUNCT(c)  (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64)  || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))

diff --git a/pod/perlre.pod b/pod/perlre.pod
index 61907f8..e5f9066 100644 (file)
--- a/pod/perlre.pod
+++ b/pod/perlre.pod
@@ -260,7 +260,8 @@ Any control character.  Usually characters that don't produce output as
 such but instead control the terminal somehow: for example newline and
 backspace are control characters.  All characters with ord() less than
 32 are most often classified as control characters (assuming ASCII,
-the ISO Latin character sets, and Unicode).
+the ISO Latin character sets, and Unicode), as is the character with
+the ord() value of 127 (C<DEL>).
 
 =item graph
 

diff --git a/regcomp.c b/regcomp.c
index 575bd43..cdf42f5 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -4351,7 +4351,7 @@ Perl_regdump(pTHX_ regexp *r)
 STATIC void
 S_put_byte(pTHX_ SV *sv, int c)
 {
-    if (isCNTRL(c) || c == 127 || c == 255 || !isPRINT(c))
+    if (isCNTRL(c) || c == 255 || !isPRINT(c))
        Perl_sv_catpvf(aTHX_ sv, "\\%o", c);
     else if (c == '-' || c == ']' || c == '\\' || c == '^')
        Perl_sv_catpvf(aTHX_ sv, "\\%c", c);

diff --git a/t/op/pat.t b/t/op/pat.t
index 57dc2f2..99d9333 100755 (executable)
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -6,7 +6,7 @@
 
 $| = 1;
 
-print "1..672\n";
+print "1..674\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -1929,3 +1929,17 @@ print "not " unless chr(0x38c) =~ /\p{InGreek}/; # singleton
 print "ok 672\n";
 
 
+##
+## Test [:cntrl:]...
+##
+## Should probably put in tests for all the POSIX stuff, but not sure how to
+## guarantee a specific locale......
+##
+$AllBytes = join('', map { chr($_) } 0..255);
+($x = $AllBytes) =~ s/[[:cntrl:]]//g;
+if ($x ne join('', map { chr($_) } 0x20..0x7E, 0x80..0xFF)) { print "not " };
+print "ok 673\n";
+
+($x = $AllBytes) =~ s/[^[:cntrl:]]//g;
+if ($x ne join('', map { chr($_) } 0..0x1F, 0x7F)) { print "not " };
+print "ok 674\n";