From f4df43b5ee48f8f744bf0e51a622822865e03c4b Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Wed, 20 Jul 2011 23:52:57 -0700
Subject: [PATCH] [perl #81290] assertion failure with lock &lvsub
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

With this commit, locking an lvalue subroutine no longer tries to lock
the subroutine itself (triggering an assertion in pp_lock).  Instead,
the &foo syntax is treated as a scalar lvalue expression, as with tie,
so the return value gets locked.  Non-lvalue sub calls still produce a
‘Can't modify’ error, as they are not modifiable.

This also stops lock from trying to return a sub as though it were a
scalar, thereby breaking this JAPH I’ve just written:-)

sub _:lvalue{$x}for(lock&_){$_
="Just another Perl hacker,\n"}
print+prototype"_"
---
 MANIFEST          |  1 +
 op.c              |  2 +-
 pod/perldelta.pod |  5 ++++-
 t/op/lock.t       | 18 ++++++++++++++++++
 4 files changed, 24 insertions(+), 2 deletions(-)
 create mode 100644 t/op/lock.t

diff --git a/MANIFEST b/MANIFEST
index 95f9d61..8635bf6 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4970,6 +4970,7 @@ t/op/lfs.t			See if large files work for perlio
 t/op/list.t			See if array lists work
 t/op/localref.t			See if local ${deref} works
 t/op/local.t			See if local works
+t/op/lock.t			Tests for lock args & retval (no threads)
 t/op/loopctl.t			See if next/last/redo work
 t/op/lop.t			See if logical operators work
 t/op/magic-27839.t		Test for #27839, skipped for minitest
diff --git a/op.c b/op.c
index ab65490..1ff086b 100644
--- a/op.c
+++ b/op.c
@@ -1878,7 +1878,7 @@ Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
 
     switch (o->op_type) {
     case OP_ENTERSUB:
-	if ((type == OP_EXISTS || type == OP_DEFINED || type == OP_LOCK) &&
+	if ((type == OP_EXISTS || type == OP_DEFINED) &&
 	    !(o->op_flags & OPf_STACKED)) {
 	    o->op_type = OP_RV2CV;             /* entersub => rv2cv */
 	    o->op_ppaddr = PL_ppaddr[OP_RV2CV];
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 8bbdbd6..a3d92cd 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -333,7 +333,10 @@ L</Modules and Pragmata>.
 
 =item *
 
-XXX
+Locking an lvalue subroutine (via C<lock &lvsub>) now locks the return
+value, instead of trying to lock the sub (which has no effect).  It also no
+longer tries to return the sub as a scalar, resulting in strange side
+effects like C<ref \$_> returning "CODE" in some instances.
 
 =back
 
diff --git a/t/op/lock.t b/t/op/lock.t
new file mode 100644
index 0000000..2fd6782
--- /dev/null
+++ b/t/op/lock.t
@@ -0,0 +1,18 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = qw(. ../lib);
+    require './test.pl';
+}
+plan tests => 5;
+
+is \lock $foo, \$foo, 'lock returns a scalar argument';
+is  lock @foo, \@foo, 'lock returns a ref to its array argument';
+is  lock %foo, \%foo, 'lock returns a ref to its hash argument';
+eval { lock &foo }; my $file = __FILE__; my $line = __LINE__;
+is $@, "Can't modify non-lvalue subroutine call at $file line $line.\n",
+     'Error when locking non-lvalue sub';
+
+sub eulavl : lvalue { $x }
+is \lock &eulavl, \$x, 'locking lvalue sub acts on retval, just like tie';
-- 
1.8.3.1