New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Tied hashes stringify their hash keys as of 5.8.3 #11798
Comments
From @cpansproutAs of this commit: commit 113738b merge hv_fetch and hv_fetch_ent into hv_fetch_common tied hashes now stringify their keys: { sub TIEHASH { bless [] } tie %h, ""; $h{bless [], o} = 34; That should not print ‘stingify’. The value passed to STORE is not stringified, but the keys get stringified unnecessarily on the way. This caused a script to blow up in my face, because the object in question couldn’t stringify without creating another object that was stored in the same cache. Flags: Site configuration information for perl 5.15.5: Configured by sprout at Sat Nov 26 11:40:22 PST 2011. Summary of my perl5 (revision 5 version 15 subversion 5) configuration: Locally applied patches: @INC for perl 5.15.5: Environment for perl 5.15.5: |
From @jkeenanOn Sun, 11 Dec 2011 21:15:10 GMT, sprout wrote:
This ticket was filed nearly 6 years ago. It concerns a commit made nearly 14 years ago. But in the time the ticket has been open there have been no other comments. Can we infer that this is not a problem that needs fixing? Thank you very much. -- |
The RT System itself - Status changed from 'new' to 'open' |
From @cpansproutOn Fri, 29 Sep 2017 19:39:30 -0700, jkeenan wrote:
It is still a bug, and it is still fixable. -- Father Chrysostomos |
From blgl@stacken.kth.seFixes the reported problem; causes no new test failures. Do other cases exist where hash keys should not be stringified? /Bo Lindbergh |
From blgl@stacken.kth.se0001-Fix-perl-105918-Tied-hashes-stringify-their-hash-key.patchFrom d2c9fc2acc9aa9d9abadf8d6cffd406a59345661 Mon Sep 17 00:00:00 2001
From: Bo Lindbergh <blgl@stacken.kth.se>
Date: Sat, 30 Sep 2017 14:53:54 +0200
Subject: [PATCH] Fix [perl #105918] Tied hashes stringify their hash keys
---
hv.c | 29 ++++++++++++++++-------------
t/op/hash.t | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 66 insertions(+), 13 deletions(-)
diff --git a/hv.c b/hv.c
index 7029e28..e63e93c 100644
--- a/hv.c
+++ b/hv.c
@@ -346,6 +346,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
HE *entry;
HE **oentry;
SV *sv;
+ bool is_tied;
bool is_utf8;
bool in_collision;
int masked_flags;
@@ -359,6 +360,8 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
assert(SvTYPE(hv) == SVt_PVHV);
+ is_tied = mg_find((const SV *)hv, PERL_MAGIC_tied) != NULL;
+
if (SvSMAGICAL(hv) && SvGMAGICAL(hv) && !(action & HV_DISABLE_UVAR_XKEY)) {
MAGIC* mg;
if ((mg = mg_find((const SV *)hv, PERL_MAGIC_uvar))) {
@@ -385,15 +388,17 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
}
}
if (keysv) {
- if (flags & HVhek_FREEKEY)
- Safefree(key);
- key = SvPV_const(keysv, klen);
- is_utf8 = (SvUTF8(keysv) != 0);
- if (SvIsCOW_shared_hash(keysv)) {
- flags = HVhek_KEYCANONICAL | (is_utf8 ? HVhek_UTF8 : 0);
- } else {
- flags = is_utf8 ? HVhek_UTF8 : 0;
- }
+ if (! is_tied) {
+ if (flags & HVhek_FREEKEY)
+ Safefree(key);
+ key = SvPV_const(keysv, klen);
+ is_utf8 = (SvUTF8(keysv) != 0);
+ if (SvIsCOW_shared_hash(keysv)) {
+ flags = HVhek_KEYCANONICAL | (is_utf8 ? HVhek_UTF8 : 0);
+ } else {
+ flags = is_utf8 ? HVhek_UTF8 : 0;
+ }
+ }
} else {
is_utf8 = cBOOL(flags & HVhek_UTF8);
}
@@ -406,8 +411,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
xhv = (XPVHV*)SvANY(hv);
if (SvMAGICAL(hv)) {
if (SvRMAGICAL(hv) && !(action & (HV_FETCH_ISSTORE|HV_FETCH_ISEXISTS))) {
- if (mg_find((const SV *)hv, PERL_MAGIC_tied)
- || SvGMAGICAL((const SV *)hv))
+ if (is_tied || SvGMAGICAL((const SV *)hv))
{
/* FIXME should be able to skimp on the HE/HEK here when
HV_FETCH_JUST_SV is true. */
@@ -482,8 +486,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
#endif
} /* ISFETCH */
else if (SvRMAGICAL(hv) && (action & HV_FETCH_ISEXISTS)) {
- if (mg_find((const SV *)hv, PERL_MAGIC_tied)
- || SvGMAGICAL((const SV *)hv)) {
+ if (is_tied || SvGMAGICAL((const SV *)hv)) {
/* I don't understand why hv_exists_ent has svret and sv,
whereas hv_exists only had one. */
SV * const svret = sv_newmortal();
diff --git a/t/op/hash.t b/t/op/hash.t
index 6c9fa1b..c9bbddc 100644
--- a/t/op/hash.t
+++ b/t/op/hash.t
@@ -259,6 +259,56 @@ package Magic {
::is(join( ':', %inner), "x:y", "magic keys");
}
+# [perl #105918] Tied hashes stringify their hash keys
+{
+ my($stringifications, $key, %tied, $result);
+
+ package Overloads;
+
+ use overload
+ '""' => sub { ++$stringifications; };
+
+ $stringifications = 0;
+ $key = bless([]);
+
+ package Ties;
+
+ sub TIEHASH
+ {
+ my($class) = @_;
+
+ bless([], $class);
+ }
+
+ sub FETCH
+ {
+ 1;
+ }
+ sub STORE
+ {
+ 2;
+ }
+
+ sub EXISTS
+ {
+ 4;
+ }
+
+ sub DELETE
+ {
+ 8;
+ }
+
+ package main;
+
+ tie(%tied, Ties::);
+ $tied{$key} = 0;
+ $result = $tied{$key}
+ + exists($tied{$key})
+ + delete $tied{$key};
+ untie(%tied);
+ is($stringifications, 0, "no unwanted stringification");
+}
done_testing();
--
2.7.1
|
Migrated from rt.perl.org#105918 (status was 'open')
Searchable as RT105918$
The text was updated successfully, but these errors were encountered: