summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2011-04-18 21:29:11 -0700
committerFather Chrysostomos <sprout@cpan.org>2011-04-18 21:29:32 -0700
commitd806590792484020987549ec4683b175c90d6263 (patch)
treea86f5ad78f320212167e68200755801e977bf194
parent006671a67d63718163a0f4771c9dc358db053aad (diff)
downloadperl-d806590792484020987549ec4683b175c90d6263.tar.gz
Make keys $scalar an lvalue
This does a run-time check to see whether $scalar is a hash ref, and dies if it is not. This is to keep keys \@_ consistent with keys @_. I cannot simply use OPf_MOD, since that indicates *potential* lvalue context (including subroutine args). So, instead, I take advantage of the fact that OPf_SPECIAL is always set on the LHS of an assignment (usually to indicate that local() should not erase the value).
-rw-r--r--op.c1
-rw-r--r--pp.c6
-rw-r--r--t/op/smartkve.t8
3 files changed, 15 insertions, 0 deletions
diff --git a/op.c b/op.c
index f22f888008..e21b9a478f 100644
--- a/op.c
+++ b/op.c
@@ -1690,6 +1690,7 @@ Perl_op_lvalue(pTHX_ OP *o, I32 type)
break;
case OP_KEYS:
+ case OP_RKEYS:
if (type != OP_SASSIGN)
goto nomod;
goto lvalue_func;
diff --git a/pp.c b/pp.c
index 5b32daf78e..4c8827065a 100644
--- a/pp.c
+++ b/pp.c
@@ -4850,6 +4850,12 @@ PP(pp_rkeys)
PL_op_desc[PL_op->op_type] );
}
+ if (PL_op->op_flags & OPf_SPECIAL && SvTYPE(sv) == SVt_PVAV)
+ DIE(aTHX_
+ "Can't modify %s in %s",
+ PL_op_desc[PL_op->op_type], PL_op_desc[PL_op->op_next->op_type]
+ );
+
/* Delegate to correct function for op type */
PUSHs(sv);
if (PL_op->op_type == OP_RKEYS || PL_op->op_type == OP_RVALUES) {
diff --git a/t/op/smartkve.t b/t/op/smartkve.t
index 7c57e7bba4..ad56e6a9c4 100644
--- a/t/op/smartkve.t
+++ b/t/op/smartkve.t
@@ -131,6 +131,14 @@ ok(defined $empty,
'Vivify: $empty (after keys $empty->{hash}) is HASHREF');
ok(!defined $empty->{hash} , 'Vivify: $empty->{hash} is undef');
+# Keys -- lvalue
+$_{foo} = "bar";
+keys \%_ = 65;
+is scalar %_, '1/128', 'keys $hashref as lvalue';
+eval 'keys \@_ = 65';
+like $@, qr/Can't modify keys on reference in scalar assignment/,
+ 'keys $arrayref as lvalue dies';
+
# Keys -- errors
$errpat = qr/
(?-x:Type of argument to keys on reference must be unblessed hashref or)