Here is a patch to make Want work with perl 5.15.
In 5.15, ‘return’ works in lvalue routines. So ‘return undef’ in lnoreturn ends up going
through the lvalue code, which croaks on &PL_sv_undef (‘Can’t return undef...’).
Turning off the lvalueness of the return with
cx->blk_u16 &= ~OPpLVAL_INTRO;
doesn’t work, because lvalue subs never copy their return values anymore (and pp_return
uses CvLVALUE(cv) to determine whether to go through the lvalue code), so you get
‘Modification of a read-only value’.
So we have to return a modifiable undef, but we don’t want a permanent variable, as the thing
assigned to it would leak until the next lnoreturn.
We can’t just say ‘return my $undef’, because of the new ‘Useless assignment to a temporary’
warning.
So disarm_temp increases the refcount so that the code in pp_sassign that produces that
warning will be fooled into thinking the scalar is still in use elsewhere.
There are also test fix-ups to avoid (valid) warnings about assigning to temporaries, and to
stop testing for Perl bugs. :-)
BTW, double_return is one of the neatest tricks I’ve seen.
diff -rup Want-0.18-i_Beo4-orig/Want.pm Want-0.18-i_Beo4/Want.pm
--- Want-0.18-i_Beo4-orig/Want.pm 2008-02-04 01:35:55.000000000 -0800
+++ Want-0.18-i_Beo4/Want.pm 2011-11-02 22:03:21.000000000 -0700
@@ -177,7 +177,7 @@ sub lnoreturn () {
croak "Can't lnoreturn except in ASSIGN context";
}
double_return();
- return undef;
+ return disarm_temp(my $undef);
}
# Some naughty people were relying on these internal methods.
@@ -291,6 +291,7 @@ I<always> be in RVALUE context.
If you need to return values from an lvalue subroutine in RVALUE context,
you should use the C<rreturn> function rather than an ordinary C<return>.
Otherwise you'll probably get a compile-time error in perl 5.6.1 and later.
+As of perl 5.16, ordinary C<return> works fine.
=item B<LVALUE>
@@ -379,7 +380,7 @@ This makes it very easy to write lvalue
backstr(my $robin) = "nibor";
print "\$robin is now $robin\n"; # $robin is now robin
-Notice that you need to put a (meaningless) return
+Notice that, prior to perl 5.16, you need to put a (meaningless) return
statement at the end of the function, otherwise you will get the
error
I<Can't modify non-lvalue subroutine call in lvalue subroutine return>.
@@ -496,8 +497,8 @@ A full list of the permitted keyword is
Use this function instead of C<return> from inside an lvalue subroutine when
you know that you're in RVALUE context. If you try to use a normal C<return>,
-you'll get a compile-time error in Perl 5.6.1 and above unless you return an
-lvalue.
+you'll get a compile-time error in Perl 5.6.1 to 5.14.x unless you return
+an lvalue. In perl 5.16, C<return> will suffice.
=item lnoreturn
@@ -505,7 +506,8 @@ Use this function instead of C<return> f
you're in ASSIGN context and you've used C<want('ASSIGN')> to carry out the
appropriate action.
-If you use C<rreturn> or C<lnoreturn>, then you have to put a bare C<return;>
+If you use C<rreturn> or C<lnoreturn>, then, unless you want to
+depend on perl 5.16 or higher, you have to put a bare C<return;>
at the very end of your lvalue subroutine, in order to stop the Perl compiler
from complaining. Think of it as akin to the C<1;> that you have to put at the
end of a module.
diff -rup Want-0.18-i_Beo4-orig/Want.xs Want-0.18-i_Beo4/Want.xs
--- Want-0.18-i_Beo4-orig/Want.xs 2008-02-03 14:29:35.000000000 -0800
+++ Want-0.18-i_Beo4/Want.xs 2011-11-02 22:11:38.000000000 -0700
@@ -676,3 +676,11 @@ double_return()
#endif
return;
+
+SV *
+disarm_temp(sv)
+SV *sv;
+ CODE:
+ RETVAL = sv_2mortal(SvREFCNT_inc(SvREFCNT_inc(sv)));
+ OUTPUT:
+ RETVAL
diff -rup Want-0.18-i_Beo4-orig/t/all.t Want-0.18-i_Beo4/t/all.t
--- Want-0.18-i_Beo4-orig/t/all.t 2011-11-02 20:10:38.000000000 -0700
+++ Want-0.18-i_Beo4/t/all.t 2011-11-02 20:33:14.000000000 -0700
@@ -13,7 +13,10 @@ sub lv :lvalue {
my $xxx;
}
-&lv = 23;
+{
+ local $^W;
+ &lv = 23;
+}
sub rv :lvalue {
print (Want::want_lvalue(0) ? "not ok 3\n" : "ok 3\n");
@@ -141,7 +144,7 @@ print ($y == 23 ? "ok 35\n" : "not ok 35
@x = \(g(37, 'LVALUE', 'LIST'));
($x) = \(scalar g(38, 'RVALUE'));
$$x = 29;
-print ($y != 29 ? "ok 39\n" : "not ok 39\n");
+print (($] ge 5.015 ? $y == 29 : $y != 29) ? "ok 39\n" : "not ok 39\n");
ng(41, 'REF') = g(40, 'HASH')->{foo};
$y = sub {}; # Just to silence warning
diff -rup Want-0.18-i_Beo4-orig/t/assign.t Want-0.18-i_Beo4/t/assign.t
--- Want-0.18-i_Beo4-orig/t/assign.t 2001-08-29 02:28:30.000000000 -0700
+++ Want-0.18-i_Beo4/t/assign.t 2011-11-02 20:33:57.000000000 -0700
@@ -25,8 +25,11 @@ sub idl :lvalue {@_[0..$#_]}
t (2, qw/RVALUE !ASSIGN/);
tl(3, qw/RVALUE !ASSIGN/);
noop(tl(4, qw/LVALUE !ASSIGN/));
-tl(5, qw/LVALUE ASSIGN/) = ();
-tl(6, 'ASSIGN') = ();
+{
+ local $^W;
+ tl(5, qw/LVALUE ASSIGN/) = ();
+ tl(6, 'ASSIGN') = ();
+}
sub backstr :lvalue {
if (want('LVALUE')) {
RT for rt.cpan.org