From 1f4ef0f182b07bd3c970ed636971821c8f754668 Mon Sep 17 00:00:00 2001
From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Wed, 27 Aug 2014 08:13:02 -0400
Subject: [PATCH] pack c/C on inf/nan.

Made them return the 0xFF byte (and warn).  Not necessarily the best
choice, but there's not that much room in just 256 bytes for all of
the inf/-inf/nan.  This same choice will need to be made with wider
integer packs.
---
 pod/perldiag.pod | 12 ++++++++++++
 pp_pack.c        | 19 +++++++++++++++++--
 t/op/infnan.t    | 13 +++++++++++--
 3 files changed, 40 insertions(+), 4 deletions(-)

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index f3adc82..2e15358 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1328,6 +1328,12 @@ Note that ASCII characters that don't map to control characters are
 discouraged, and will generate the warning (when enabled)
 L</""\c%c" is more clearly written simply as "%s"">.
 
+=item Character in 'C' format overflow in pack
+
+(W pack) You tried converting an infinity or not-a-number to an
+unsigned character, which makes no sense.  Perl behaved as if you
+tried to pack 0xFF.
+
 =item Character in 'C' format wrapped in pack
 
 (W pack) You said
@@ -1343,6 +1349,12 @@ and so on) and not for Unicode characters, so Perl behaved as if you meant
 If you actually want to pack Unicode codepoints, use the C<"U"> format
 instead.
 
+=item Character in 'c' format overflow in pack
+
+(W pack) You tried converting an infinity or not-a-number to a
+signed character, which makes no sense.  Perl behaved as if you
+tried to pack 0xFF.
+
 =item Character in 'c' format wrapped in pack
 
 (W pack) You said
diff --git a/pp_pack.c b/pp_pack.c
index 6b14751..d35a5af 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -2540,7 +2540,15 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		IV aiv;
 		fromstr = NEXTFROM;
-		aiv = SvIV(fromstr);
+                if (SvNOK(fromstr) && Perl_isinfnan(SvNV(fromstr))) {
+                    /* 255 is a pretty arbitrary choice, but with
+                     * inf/-inf/nan and 256 bytes there is not much room. */
+                    aiv = 255;
+		    Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
+				   "Character in 'c' format overflow in pack");
+                }
+                else
+                    aiv = SvIV(fromstr);
 		if ((-128 > aiv || aiv > 127))
 		    Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
 				   "Character in 'c' format wrapped in pack");
@@ -2555,7 +2563,14 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    while (len-- > 0) {
 		IV aiv;
 		fromstr = NEXTFROM;
-		aiv = SvIV(fromstr);
+                if (SvNOK(fromstr) && Perl_isinfnan(SvNV(fromstr))) {
+                    /* See the 'c' case. */
+                    aiv = 255;
+		    Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
+				   "Character in 'C' format overflow in pack");
+                }
+                else
+                    aiv = SvIV(fromstr);
 		if ((0 > aiv || aiv > 0xff))
 		    Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
 				   "Character in 'C' format wrapped in pack");
diff --git a/t/op/infnan.t b/t/op/infnan.t
index 50dbeda..c147787 100644
--- a/t/op/infnan.t
+++ b/t/op/infnan.t
@@ -24,8 +24,8 @@ my @NaN = ("NAN", "nan", "qnan", "SNAN", "NanQ", "NANS",
 
 my @num_fmt = qw(e f g a d u o b x p);
 
-my $inf_tests = 11 + @num_fmt + 4 + 3 * @PInf + 3 * @NInf + 5 + 3;
-my $nan_tests =  7 + @num_fmt + 2 + 2 * @NaN + 3;
+my $inf_tests = 11 + @num_fmt + 8 + 3 * @PInf + 3 * @NInf + 5 + 3;
+my $nan_tests =  7 + @num_fmt + 4 + 2 * @NaN + 3;
 
 my $infnan_tests = 4;
 
@@ -69,6 +69,12 @@ SKIP: {
 
       is(sprintf("%c", $NInf), chr(0xFFFD), "$NInf sprintf %c is Inf");
       is(chr($NInf), chr(0xFFFD), "$NInf chr() is U+FFFD");
+
+      is(pack('C', $PInf), chr(0xFF), "$PInf pack C is 0xFF byte");
+      is(pack('c', $PInf), chr(0xFF), "$PInf pack c is 0xFF byte");
+
+      is(pack('C', $NInf), chr(0xFF), "$NInf pack C is 0xFF byte");
+      is(pack('c', $NInf), chr(0xFF), "$NInf pack c is 0xFF byte");
   }
 
   for my $i (@PInf) {
@@ -127,6 +133,9 @@ SKIP: {
 
       is(sprintf("%c", $NaN), chr(0xFFFD), "$NaN sprintf %c is Inf");
       is(chr($NaN), chr(0xFFFD), "$NaN chr() is U+FFFD");
+
+      is(pack('C', $NaN), chr(0xFF), "$NaN pack C is 0xFF byte");
+      is(pack('c', $NaN), chr(0xFF), "$NaN pack c is 0xFF");
   }
 
   for my $i (@NaN) {
-- 
1.8.3.1