diff options
author | Father Chrysostomos <sprout@cpan.org> | 2012-06-26 17:41:40 -0700 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2012-06-27 00:51:44 -0700 |
commit | b3fe86802b6b6c36e1eb49a8b2a063d758f2e404 (patch) | |
tree | ed82aa7e46bad6dc3861222f1ee94ffc25d92953 | |
parent | 9d7bf48eff0f88f150105f63dab97d99b6b4e1fc (diff) | |
download | perl-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.c | 21 | ||||
-rw-r--r-- | t/op/chr.t | 12 |
2 files changed, 27 insertions, 6 deletions
@@ -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"); } + |