Skip to content

Commit 0684569

Browse files
committed
Preserve behaviour of allowing an undefined key for tied hash lookups
The previous change prevented the warning, but forced the hash key for defelem to the empty string if the original key was undefined. This wasn't a problem if the hash was already tied when the function was called (and the PVLV created), since the resulting PVLV used packelem magic instead of defelem. But if the hash was tied after the PVLV was created references through the PVLV would be working on $hash{""} instead of $hash{+undef}, breaking this possibly used feature. One issue is whether we want to allow undef keys for tied hash, if we do we should probably make them warn less. Fixes #22423
1 parent a0b9367 commit 0684569

File tree

2 files changed

+53
-6
lines changed

2 files changed

+53
-6
lines changed

mg.c

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2616,7 +2616,15 @@ Perl_defelem_target(pTHX_ SV *sv, MAGIC *mg)
26162616
if (LvTARGLEN(sv)) {
26172617
if (mg->mg_obj) {
26182618
SV * const ahv = LvTARG(sv);
2619-
SV * const index_sv = SvOK(mg->mg_obj) ? mg->mg_obj : &PL_sv_no;
2619+
/* A call like $h{$s} with $s not defined would warn
2620+
here, which could be confusing. A tied hash could treat
2621+
an undef index specially, so we need to preserve undef
2622+
for a tied hash.
2623+
*/
2624+
SV * const index_sv =
2625+
SvOK(mg->mg_obj) ||
2626+
(SvRMAGICAL(ahv) && mg_find((const SV *)ahv, PERL_MAGIC_tied))
2627+
? mg->mg_obj : &PL_sv_no;
26202628
HE * const he = hv_fetch_ent(MUTABLE_HV(ahv), index_sv, FALSE, 0);
26212629
if (he)
26222630
targ = HeVAL(he);

t/lib/warnings/mg

Lines changed: 44 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -93,7 +93,10 @@ Use of uninitialized value $s in hash element at - line 6.
9393
# NAME Use of uninitialized value $_[0] in defined operator (tied)
9494
# github 22423
9595
# should we allow tied hashes to distinguish between undef and ""
96-
# without warning? For now test the current behaviour
96+
# without warning? For now test the current behaviour, this
97+
# didn't produce the warning described in github #22423 since
98+
# if the hash is tied for the call the PVLV uses packelem (tie)
99+
# magic rather than defelem magic
97100
use v5.36;
98101
++$|;
99102
sub f { defined $_[0] }
@@ -124,9 +127,45 @@ sub EXISTS {
124127
}
125128

126129
EXPECT
127-
Use of uninitialized value $s in hash element at - line 9.
128-
Use of uninitialized value in hash element at - line 10.
129-
Use of uninitialized value in hash element at - line 12.
130+
Use of uninitialized value $s in hash element at - line 12.
131+
Use of uninitialized value in hash element at - line 13.
132+
Use of uninitialized value in hash element at - line 15.
130133
1
131-
Use of uninitialized value $s in hash element at - line 13.
134+
Use of uninitialized value $s in hash element at - line 16.
135+
########
136+
# NAME Use of uninitialized value $_[0] in defined operator (tied2)
137+
# github 22423
138+
# In this case we have a tied hash, but it's only tied after the
139+
# PVLV is created for the element. This *does* produce the warning
140+
# complained about in #22423
141+
use v5.36;
142+
++$|;
143+
my %h;
144+
sub f {
145+
tie %h, "Foo";
146+
defined $_[0];
147+
}
148+
my $s;
149+
say f($h{$s}) ? "defined" : "undefined";
132150

151+
package Foo;
152+
153+
sub TIEHASH {
154+
bless { "+undef" => "tied-undef" }, shift;
155+
}
156+
sub STORE($self, $index, $val) {
157+
$self->{defined $index ? $index : "+undef"} = $val;
158+
}
159+
sub FETCH($self, $index) {
160+
$self->{defined $index ? $index : "+undef"};
161+
}
162+
sub EXISTS($self, $index) {
163+
exists $self->{defined $index ? $index : "+undef"};
164+
}
165+
sub DELETE($self, $index) {
166+
delete $self->{defined $index ? $index : "+undef"};
167+
}
168+
EXPECT
169+
Use of uninitialized value $s in hash element at - line 13.
170+
Use of uninitialized value $_[0] in defined operator at - line 10.
171+
defined

0 commit comments

Comments
 (0)