diff options
| -rw-r--r-- | pp_hot.c | 5 | ||||
| -rwxr-xr-x | t/op/sub_lval.t | 47 |
2 files changed, 49 insertions, 3 deletions
@@ -2441,7 +2441,10 @@ PP(pp_leavesublv) MARK = newsp + 1; EXTEND_MORTAL(1); if (MARK == SP) { - if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) { + /* Temporaries are bad unless they happen to be elements + * of a tied hash or array */ + if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY) && + !(SvRMAGICAL(TOPs) && mg_find(TOPs, PERL_MAGIC_tiedelem))) { LEAVE; cxstack_ix--; POPSUB(cx,sv); diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t index c161b4b936..953a1e0ae9 100755 --- a/t/op/sub_lval.t +++ b/t/op/sub_lval.t @@ -1,4 +1,4 @@ -print "1..68\n"; +print "1..72\n"; BEGIN { chdir 't' if -d 't'; @@ -530,8 +530,51 @@ sub lval2 : lvalue { $ary[1]; } print "not " unless join(':', @ary) eq "1:2:6"; print "ok 64\n"; +# check that an element of a tied hash/array can be assigned to via lvalueness + +package Tie_Hash; + +our ($key, $val); +sub TIEHASH { bless \my $v => __PACKAGE__ } +sub STORE { ($key, $val) = @_[1,2] } + +package main; +sub lval_tie_hash : lvalue { + tie my %t => 'Tie_Hash'; + $t{key}; +} + +eval { lval_tie_hash() = "value"; }; + +print "# element of tied hash: $@\nnot " if $@; +print "ok 65\n"; + +print "not " if "$Tie_Hash::key-$Tie_Hash::val" ne "key-value"; +print "ok 66\n"; + + +package Tie_Array; + +our @val; +sub TIEARRAY { bless \my $v => __PACKAGE__ } +sub STORE { $val[ $_[1] ] = $_[2] } + +package main; +sub lval_tie_array : lvalue { + tie my @t => 'Tie_Array'; + $t[0]; +} + +eval { lval_tie_array() = "value"; }; + +print "# element of tied array: $@\nnot " if $@; +print "ok 67\n"; + +print "not " if $Tie_Array::val[0] ne "value"; +print "ok 68\n"; + require './test.pl'; -curr_test(65); +curr_test(69); TODO: { local $TODO = 'test explicit return of lval expr'; |