From: Simon Cozens <simon@netthink.co.uk>
Date: Sat, 12 May 2001 17:58:41 +0000 (+0100)
Subject: Based on
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ac7cd81aae231be8bd5734f1506e627995fef570;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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