[perl #107366] Allow attributes to set :lvalue on defined sub

This provides enough rope for those who want to hang themselves, and
also for those who know how to use the rope without hanging them-
selves. :-)

Since this is not generally a reliable thing to be doing, a warning is emitted whenever :lvalue is turned on or off on a defined subroutine.

But attributes.pm will flip the flag anyway.  :lvalue in a sub declar-
ation still refuses to modify a defined Perl sub, as before.

diff --git a/ext/attributes/attributes.pm b/ext/attributes/attributes.pm
index 4d27f4f..2ce7d87 100644 (file)
--- a/ext/attributes/attributes.pm
+++ b/ext/attributes/attributes.pm
@@ -39,8 +39,8 @@ sub _modify_attrs_and_deprecate {
            warnings::warnif(
                'misc',
                "lvalue attribute "
-                  . (/^-/ ? "cannot be removed" : "ignored")
-                  . " after the subroutine has been defined"
+                  . (/^-/ ? "removed from" : "applied to")
+                  . " already-defined subroutine"
            );
            0;
        } : 1

diff --git a/ext/attributes/attributes.xs b/ext/attributes/attributes.xs
index d771889..e92f793 100644 (file)
--- a/ext/attributes/attributes.xs
+++ b/ext/attributes/attributes.xs
@@ -48,14 +48,15 @@ modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs)
                switch (name[3]) {
                case 'l':
                    if (memEQ(name, "lvalue", 6)) {
-                       if (!CvISXSUB(MUTABLE_CV(sv))
+                       bool warn =
+                           !CvISXSUB(MUTABLE_CV(sv))
                         && CvROOT(MUTABLE_CV(sv))
-                        && !CvLVALUE(MUTABLE_CV(sv)) != negated)
-                           break;
+                        && !CvLVALUE(MUTABLE_CV(sv)) != negated;
                        if (negated)
                            CvFLAGS(MUTABLE_CV(sv)) &= ~CVf_LVALUE;
                        else
                            CvFLAGS(MUTABLE_CV(sv)) |= CVf_LVALUE;
+                       if (warn) break;
                        continue;
                    }
                    break;

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 1b67ccd..5f6ed83 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2627,18 +2627,24 @@ You may wish to switch to using L<Math::BigInt> explicitly.
 by that?  lstat() makes sense only on filenames.  (Perl did a fstat()
 instead on the filehandle.)
 
-=item lvalue attribute cannot be removed after the subroutine has been defined
+=item lvalue attribute %s already-defined subroutine
 
-(W misc) The lvalue attribute on a Perl subroutine cannot be turned off
-once the subroutine is defined.
+(W misc) Although L<attributes.pm|attributes> allows this, turning the lvalue
+attribute on or off on a Perl subroutine that is already defined
+does not always work properly.  It may or may not do what you
+want, depending on what code is inside the subroutine, with exact
+details subject to change between Perl versions.  Only do this
+if you really know what you are doing.
 
 =item lvalue attribute ignored after the subroutine has been defined
 
-(W misc) Making a Perl subroutine an lvalue subroutine after it has been
-defined, whether by declaring the subroutine with an lvalue attribute
-or by using L<attributes.pm|attributes>, is not possible.  To make the subroutine an
-lvalue subroutine, add the lvalue attribute to the definition, or put
-the declaration before the definition.
+(W misc) Using the C<:lvalue> declarative syntax to make a Perl
+subroutine an lvalue subroutine after it has been defined is
+not permitted.  To make the subroutine an lvalue subroutine,
+add the lvalue attribute to the definition, or put the C<sub
+foo :lvalue;> declaration before the definition.
+
+See also L<attributes.pm|attributes>.
 
 =item Malformed integer in [] in pack
 

diff --git a/t/op/attrs.t b/t/op/attrs.t
index f3d1165..79ef361 100644 (file)
--- a/t/op/attrs.t
+++ b/t/op/attrs.t
@@ -341,28 +341,28 @@ foreach my $test (@tests) {
   sub  ent         {}
   sub lent :lvalue {}
   my $posmsg =
-      'lvalue attribute ignored after the subroutine has been defined at '
+      'lvalue attribute applied to already-defined subroutine at '
      .'\(eval';
   my $negmsg =
-      'lvalue attribute cannot be removed after the subroutine has been '
-     .'defined at \(eval';
+      'lvalue attribute removed from already-defined subroutine at '
+     .'\(eval';
   eval 'use attributes __PACKAGE__, \&ent, "lvalue"';
   like $w, qr/^$posmsg/, 'lvalue attr warning on def sub';
-  is join("",&attributes::get(\&ent)), "",'lvalue attr ignored on def sub';
+  is join("",&attributes::get(\&ent)), "lvalue",':lvalue applied anyway';
   $w = '';
   eval 'use attributes __PACKAGE__, \&lent, "lvalue"; 1' or die;
   is $w, "", 'no lvalue warning on def lvalue sub';
   eval 'use attributes __PACKAGE__, \&lent, "-lvalue"';
-  like $w, qr/^$negmsg/, 'lvalue attr warning on def sub';
-  is join("",&attributes::get(\&lent)), "lvalue",
-       '-lvalue ignored on def sub';
+  like $w, qr/^$negmsg/, '-lvalue attr warning on def sub';
+  is join("",&attributes::get(\&lent)), "",
+       'lvalue attribute removed anyway';
   $w = '';
-  eval 'use attributes __PACKAGE__, \&ent, "-lvalue"; 1' or die;
-  is $w, "", 'no lvalue warning on def lvalue sub';
+  eval 'use attributes __PACKAGE__, \&lent, "-lvalue"; 1' or die;
+  is $w, "", 'no -lvalue warning on def non-lvalue sub';
   no warnings 'misc';
-  eval 'use attributes __PACKAGE__, \&ent, "lvalue"';
+  eval 'use attributes __PACKAGE__, \&lent, "lvalue"';
   is $w, "", 'no lvalue warnings under no warnings misc';
-  eval 'use attributes __PACKAGE__, \&lent, "-lvalue"';
+  eval 'use attributes __PACKAGE__, \&ent, "-lvalue"';
   is $w, "", 'no -lvalue warnings under no warnings misc';
 }