From f79aa60b66082c8bff80f325979742bfb6c73709 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Sun, 14 Aug 2011 19:16:14 -0700 Subject: [PATCH] Make lock(&foo) syntax nominally lock the subroutine In 5.10, lock(&foo) was an error for non-lvalue subs. For lvalue subs, it passed &foo to the lockhook and return \&foo. In 5.12, lock(&foo) was still an error for non-lvalue subs. For lvalue subs, it would pass &foo to the lockhook and then either trip an assertion (-DDEBUGGING) or return &foo, resulting in inter- esting bugs. Commit f4df43b5e changed lock(&lvalue_sub) to call the sub and lock its return value. As Reini Urban pointed out in , locking a subroutine does have its uses. Since lock(&foo) has never really worked anyway, we can still change this. So, for lvalue subs, this reverts back to the 5.10 behaviour. For non-lvalue subs, it now behaves the same way, the lvalue flag making no difference. Note that it still causes an error at run-time, if threads::shared is loaded, as its lockhook is conservative in what it accepts. But this change allows for future extensibility, unlike f4df43b5e. A note about the implementation: There are two pieces of code (at least) in op.c that convert an entersub op into an rv2cv, one in S_doref and the other in Perl_op_lvalue_flags. Originally (before f4df43b5e) it was S_doref that took care of that for OP_LOCK. But Perl_op_lvalue_flags is called first, so it would assume it was an assignment to a sub call and croak if there was no lvalue sub in the symbol table. This commit adds back the special case for OP_LOCK, but in Perl_op_lvalue_flags, not S_doref. --- op.c | 3 ++- pod/perldelta.pod | 13 ++++++++----- pod/perlfunc.pod | 2 +- pp.c | 4 ++-- t/op/cproto.t | 2 +- t/op/lock.t | 6 ++---- 6 files changed, 16 insertions(+), 14 deletions(-) diff --git a/op.c b/op.c index 4f8693a..b3c5f86 100644 --- a/op.c +++ b/op.c @@ -1705,7 +1705,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) break; goto nomod; case OP_ENTERSUB: - if ((type == OP_UNDEF || type == OP_REFGEN) && + if ((type == OP_UNDEF || type == OP_REFGEN || type == OP_LOCK) && !(o->op_flags & OPf_STACKED)) { o->op_type = OP_RV2CV; /* entersub => rv2cv */ /* Both ENTERSUB and RV2CV use this bit, but for different pur- @@ -10415,6 +10415,7 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code, str[n++] = '$'; str[n++] = '@'; str[n++] = '%'; + if (i == OP_LOCK) str[n++] = '&'; str[n++] = '*'; str[n++] = ']'; } diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 0d87c3a..2309a09 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -480,14 +480,17 @@ L. =item * -Locking an lvalue subroutine (via C) 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 returning "CODE" in some instances. +Locking a subroutine (via C) is no longer a compile-time error +for regular subs. For lvalue subroutines, it no longer tries to return the +sub as a scalar, resulting in strange side effects like C +returning "CODE" in some instances. + +C is now a run-time error if L is loaded (a +no-op otherwise), but that may be rectified in a future version. =item * -C's prototype has been corrected to C<(\[$@%*])> from C<(\$)>, which +C's prototype has been corrected to C<(\[$@%&*])> from C<(\$)>, which was just wrong. =item * diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 264fbdc..04c6a05 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -3095,7 +3095,7 @@ This function places an advisory lock on a shared variable or referenced object contained in I until the lock goes out of scope. The value returned is the scalar itself, if the argument is a scalar, or a -reference, if the argument is a hash or array. +reference, if the argument is a hash, array or subroutine. lock() is a "weak keyword" : this means that if you've defined a function by this name (before any calls to it), that function will be called diff --git a/pp.c b/pp.c index ca94935..3421d97 100644 --- a/pp.c +++ b/pp.c @@ -5914,9 +5914,9 @@ PP(pp_lock) dSP; dTOPss; SV *retsv = sv; - assert(SvTYPE(retsv) != SVt_PVCV); SvLOCK(sv); - if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV) { + if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV + || SvTYPE(retsv) == SVt_PVCV) { retsv = refto(retsv); } SETs(retsv); diff --git a/t/op/cproto.t b/t/op/cproto.t index 1476ae6..e995416 100644 --- a/t/op/cproto.t +++ b/t/op/cproto.t @@ -138,7 +138,7 @@ link ($$) listen (*$) local undef localtime (;$) -lock (\[$@%*]) +lock (\[$@%&*]) log (_) lstat (;*) lt undef diff --git a/t/op/lock.t b/t/op/lock.t index 2fd6782..c40ec4c 100644 --- a/t/op/lock.t +++ b/t/op/lock.t @@ -10,9 +10,7 @@ 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'; +is lock &foo, \&foo, 'lock returns a ref to its code argument'; sub eulavl : lvalue { $x } -is \lock &eulavl, \$x, 'locking lvalue sub acts on retval, just like tie'; +is lock &eulavl, \&eulavl, 'lock returns a ref to its lvalue sub arg'; -- 2.7.4