From b3fe86802b6b6c36e1eb49a8b2a063d758f2e404 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Tue, 26 Jun 2012 17:41:40 -0700
Subject: [PATCH] Make srand respect magic

It was returning U+FFFD for negative numbers, but only for non-magical
variables.
---
 pp.c       | 21 ++++++++++++++++-----
 t/op/chr.t | 12 +++++++++++-
 2 files changed, 27 insertions(+), 6 deletions(-)

diff --git a/pp.c b/pp.c
index 156a500..f4c5693 100644
--- a/pp.c
+++ b/pp.c
@@ -3256,18 +3256,29 @@ PP(pp_chr)
     char *tmps;
     UV value;
 
-    if (((SvIOK_notUV(TOPs) && SvIV(TOPs) < 0)
+    SvGETMAGIC(TOPs);
+    if (((SvIOKp(TOPs) && !SvIsUV(TOPs) && SvIV_nomg(TOPs) < 0)
 	 ||
-	 (SvNOK(TOPs) && SvNV(TOPs) < 0.0))) {
+	 (SvNOKp(TOPs) && SvNV_nomg(TOPs) < 0.0))) {
 	if (IN_BYTES) {
-	    value = POPu; /* chr(-1) eq chr(0xff), etc. */
+	    value = SvUV_nomg(TOPs); /* chr(-1) eq chr(0xff), etc. */
+	    (void)POPs;
 	} else {
 	    SV *top = POPs;
-	    Perl_ck_warner(aTHX_ packWARN(WARN_UTF8), "Invalid negative number (%"SVf") in chr", top);
+	    if (ckWARN(WARN_UTF8)) {
+		if (SvGMAGICAL(top)) {
+		    SV *top2 = sv_newmortal();
+		    sv_setsv_nomg(top2, top);
+		    top = top2;
+		}
+		Perl_warner(aTHX_ packWARN(WARN_UTF8),
+			   "Invalid negative number (%"SVf") in chr", top);
+	    }
 	    value = UNICODE_REPLACEMENT;
 	}
     } else {
-	value = POPu;
+	value = SvUV_nomg(TOPs);
+	(void)POPs;
     }
 
     SvUPGRADE(TARG,SVt_PV);
diff --git a/t/op/chr.t b/t/op/chr.t
index 5ac453f..510492e 100644
--- a/t/op/chr.t
+++ b/t/op/chr.t
@@ -6,7 +6,7 @@ BEGIN {
     require "test.pl";
 }
 
-plan tests => 34;
+plan tests => 38;
 
 # Note that t/op/ord.t already tests for chr() <-> ord() rountripping.
 
@@ -30,6 +30,15 @@ is(chr(-3.0), "\x{FFFD}");
     is(chr(-2  ), "\xFE");
     is(chr(-3.0), "\xFD");
 }
+# Make sure -1 is treated the same way when coming from a tied variable
+sub TIESCALAR {bless[]}
+sub STORE { $_[0][0] = $_[1] }
+sub FETCH { $_[0][0] }
+tie $t, "";
+$t = -1; is chr $t, chr -1, 'chr $tied when $tied is -1';
+$t = -2; is chr $t, chr -2, 'chr $tied when $tied is -2';
+$t = -1.1; is chr $t, chr -1.1, 'chr $tied when $tied is -1.1';
+$t = -2.2; is chr $t, chr -2.2, 'chr $tied when $tied is -2.2';
 
 # Check UTF-8 (not UTF-EBCDIC).
 SKIP: {
@@ -63,3 +72,4 @@ sub hexes {
     is(hexes(0x1FFFFF), "f7 bf bf bf"); # last four byte encoding
     is(hexes(0x200000), "f8 88 80 80 80");
 }
+
-- 
2.7.4