Based on

Subject: [PATCH pp.c] Wrapping pack("C",256)
Message-ID: <20010512175841.A6132@netthink.co.uk>

p4raw-id: //depot/perl@10209

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 19ac8f3..afcc2cc 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1076,6 +1076,36 @@ references can be weakened.
 with an assignment operator, which implies modifying the value itself.
 Perhaps you need to copy the value to a temporary, and repeat that.
 
+=item Character in "C" format wrapped
+
+(W pack) You said
+
+    pack("C", $x)
+
+where $x is either less than 0 or more than 255; the C<"C"> format is
+only for encoding native operating system characters (ASCII, EBCDIC,
+and so on) and not for Unicode characters, so Perl behaved as if you meant
+
+    pack("C", $x & 255)
+
+If you actually want to pack Unicode codepoints, use the C<"U"> format
+instead.
+
+=item Character in "c" format wrapped
+
+(W pack) You said
+
+    pack("c", $x)
+
+where $x is either less than -128 or more than 127; the C<"c"> format
+is only for encoding native operating system characters (ASCII, EBCDIC,
+and so on) and not for Unicode characters, so Perl behaved as if you meant
+
+    pack("c", $x & 255);
+
+If you actually want to pack Unicode codepoints, use the C<"U"> format
+instead.
+
 =item chmod() mode argument is missing initial 0
 
 (W chmod) A novice will sometimes say

diff --git a/pp.c b/pp.c
index c265e95..976d449 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -5465,9 +5465,26 @@ PP(pp_pack)
        case 'c':
            while (len-- > 0) {
                fromstr = NEXTFROM;
-               aint = SvIV(fromstr);
-               achar = aint;
-               sv_catpvn(cat, &achar, sizeof(char));
+               switch (datumtype) {
+               case 'C':
+                   aint = SvIV(fromstr);
+                   if ((aint < 0 || aint > 255) &&
+                       ckWARN(WARN_PACK))
+                       Perl_warner(aTHX_ WARN_PACK,
+                                   "Character in \"C\" format wrapped");
+                   achar = aint & 255;
+                   sv_catpvn(cat, &achar, sizeof(char));
+                   break;
+               case 'c':
+                   aint = SvIV(fromstr);
+                   if ((aint < -128 || aint > 127) &&
+                       ckWARN(WARN_PACK))
+                       Perl_warner(aTHX_ WARN_PACK,
+                                   "Character in \"c\" format wrapped");
+                   achar = aint & 255;
+                   sv_catpvn(cat, &achar, sizeof(char));
+                   break;
+               }
            }
            break;
        case 'U':

diff --git a/t/pragma/warn/pp b/t/pragma/warn/pp
index 8f42ba6..62f054a 100644 (file)
--- a/t/pragma/warn/pp
+++ b/t/pragma/warn/pp
@@ -108,3 +108,43 @@ $_ = "\x80  \xff" ;
 reverse ;
 EXPECT
 ########
+# pp.c
+use warnings 'pack' ;
+print unpack("C", pack("C",   -1)), "\n";
+print unpack("C", pack("C",    0)), "\n";
+print unpack("C", pack("C",  255)), "\n";
+print unpack("C", pack("C",  256)), "\n";
+print unpack("c", pack("c", -129)), "\n";
+print unpack("c", pack("c", -128)), "\n";
+print unpack("c", pack("c",  127)), "\n";
+print unpack("c", pack("c",  128)), "\n";
+no warnings 'pack' ;
+print unpack("C", pack("C",   -1)), "\n";
+print unpack("C", pack("C",    0)), "\n";
+print unpack("C", pack("C",  255)), "\n";
+print unpack("C", pack("C",  256)), "\n";
+print unpack("c", pack("c", -129)), "\n";
+print unpack("c", pack("c", -128)), "\n";
+print unpack("c", pack("c",  127)), "\n";
+print unpack("c", pack("c",  128)), "\n";
+EXPECT
+Character in "C" format wrapped at - line 3.
+Character in "C" format wrapped at - line 6.
+Character in "c" format wrapped at - line 7.
+Character in "c" format wrapped at - line 10.
+255
+0
+255
+0
+127
+-128
+127
+-128
+255
+0
+255
+0
+127
+-128
+127
+-128