summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2012-06-26 17:41:40 -0700
committerFather Chrysostomos <sprout@cpan.org>2012-06-27 00:51:44 -0700
commitb3fe86802b6b6c36e1eb49a8b2a063d758f2e404 (patch)
treeed82aa7e46bad6dc3861222f1ee94ffc25d92953
parent9d7bf48eff0f88f150105f63dab97d99b6b4e1fc (diff)
downloadperl-b3fe86802b6b6c36e1eb49a8b2a063d758f2e404.tar.gz
Make srand respect magic
It was returning U+FFFD for negative numbers, but only for non-magical variables.
-rw-r--r--pp.c21
-rw-r--r--t/op/chr.t12
2 files changed, 27 insertions, 6 deletions
diff --git a/pp.c b/pp.c
index 156a500a87..f4c5693bab 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 5ac453f427..510492e42b 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");
}
+