This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #101738] Make sv_sethek set the UTF8 flag correctly
authorFather Chrysostomos <sprout@cpan.org>
Thu, 20 Oct 2011 06:54:57 +0000 (23:54 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 20 Oct 2011 13:03:53 +0000 (06:03 -0700)
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.

sv.c
t/op/ref.t

diff --git a/sv.c b/sv.c
index 5ee4817..3efbc39 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -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;
        }
     }
index 36371f7..e2ba10f 100644 (file)
@@ -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 = {};