diff options
author | Father Chrysostomos <sprout@cpan.org> | 2011-10-19 23:54:57 -0700 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2011-10-20 06:03:53 -0700 |
commit | b535e014e67d62ebc1d6f4be7ca9d8aef2d8f9bc (patch) | |
tree | 2d76e4ca358972b835453df15bf1b4318fc5e515 | |
parent | 6e6358c8fab5b1ad912d0a7c5f329db10c5b9ffb (diff) | |
download | perl-b535e014e67d62ebc1d6f4be7ca9d8aef2d8f9bc.tar.gz |
[perl #101738] Make sv_sethek set the UTF8 flag correctly
It was only ever turning it on, and not turning it off if the sv hap-
pened to have it on from its previous use.
This caused ref() (which uses sv_sethek(TARG,...)) to return a shared
scalar with the UTF8 flag on, even if it was supposed to be off.
For shared scalars, the UTF8 flag on ASCII strings does make a differ-
ence. The pv *and* the flags are used in hash lookup, for speed.
So a scalar returned by ref() with the UTF8 flag on by mistake would
not work in hash lookups. exists $classes{ref $foo} would return
false, even if there were an entry for that class.
-rw-r--r-- | sv.c | 2 | ||||
-rw-r--r-- | t/op/ref.t | 11 |
2 files changed, 12 insertions, 1 deletions
@@ -4613,6 +4613,7 @@ Perl_sv_sethek(pTHX_ register SV *const sv, const HEK *const hek) sv_setpvn(sv, HEK_KEY(hek), HEK_LEN(hek)); if (HEK_UTF8(hek)) SvUTF8_on(sv); + else SvUTF8_off(sv); return; } { @@ -4624,6 +4625,7 @@ Perl_sv_sethek(pTHX_ register SV *const sv, const HEK *const hek) SvPOK_on(sv); if (HEK_UTF8(hek)) SvUTF8_on(sv); + else SvUTF8_off(sv); return; } } diff --git a/t/op/ref.t b/t/op/ref.t index 36371f7b73..e2ba10fca2 100644 --- a/t/op/ref.t +++ b/t/op/ref.t @@ -8,7 +8,7 @@ BEGIN { use strict qw(refs subs); -plan(223); +plan(224); # Test glob operations. @@ -208,6 +208,15 @@ is (ref *STDOUT{IO}, 'IO::File', 'IO refs are blessed into IO::File'); like (*STDOUT{IO}, qr/^IO::File=IO\(0x[0-9a-f]+\)$/, 'stringify for IO refs'); +{ # Test re-use of ref's TARG [perl #101738] + my $obj = bless [], '____'; + my $uniobj = bless [], chr 256; + my $get_ref = sub { ref shift }; + my $dummy = &$get_ref($uniobj); + $dummy = &$get_ref($obj); + ok exists { ____ => undef }->{$dummy}, 'ref sets UTF8 flag correctly'; +} + # Test anonymous hash syntax. $anonhash = {}; |