diff options
| -rw-r--r-- | pod/perldiag.pod | 5 | ||||
| -rw-r--r-- | pp_sys.c | 9 | ||||
| -rwxr-xr-x | t/op/tie.t | 27 |
3 files changed, 27 insertions, 14 deletions
diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 139bab98d5..3994531000 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2903,9 +2903,10 @@ filehandle that was either never opened or has since been closed. (F) This machine doesn't implement the select() system call. -=item Self-ties are not supported +=item Self-ties of arrays and hashes are not supported -(F) Self-ties are not supported in the current implementation. +(F) Self-ties are of arrays and hashes are not supported in +the current implementation. =item Semicolon seems to be missing @@ -802,9 +802,12 @@ PP(pp_tie) POPSTACK; if (sv_isobject(sv)) { sv_unmagic(varsv, how); - /* Croak if a self-tie is attempted */ - if (varsv == SvRV(sv)) - Perl_croak(aTHX_ "Self-ties are not supported"); + /* Croak if a self-tie on an aggregate is attempted. */ + if (varsv == SvRV(sv) && + (SvTYPE(sv) == SVt_PVAV || + SvTYPE(sv) == SVt_PVHV)) + Perl_croak(aTHX_ + "Self-ties of arrays and hashes are not supported"); sv_magic(varsv, sv, how, Nullch, 0); } LEAVE; diff --git a/t/op/tie.t b/t/op/tie.t index afcc4a1635..4413ed2100 100755 --- a/t/op/tie.t +++ b/t/op/tie.t @@ -162,19 +162,28 @@ $C = $B = tied %H ; untie %H; EXPECT ######## - -# verify no leak when underlying object is selfsame tied variable -my ($a, $b); +# Forbidden aggregate self-ties +my ($a, $b) = (0, 0); sub Self::TIEHASH { bless $_[1], $_[0] } -sub Self::DESTROY { $b = $_[0] + 0; } +sub Self::DESTROY { $b = $_[0] + 1; } +{ + my %c = 42; + tie %c, 'Self', \%c; +} +EXPECT +Self-ties of arrays and hashes are not supported +######## +# Allowed scalar self-ties +my ($a, $b) = (0, 0); +sub Self::TIESCALAR { bless $_[1], $_[0] } +sub Self::DESTROY { $b = $_[0] + 1; } { - my %b5; - $a = \%b5 + 0; - tie %b5, 'Self', \%b5; + my $c = 42; + $a = $c + 0; + tie $c, 'Self', \$c; } -die unless $a == $b; +die unless $a == 0 && $b == 43; EXPECT -Self-ties are not supported ######## # Interaction of tie and vec |