attributes.pm: warn & don’t apply :lvalue to defined subs

This is something that ‘sub foo :lvalue;’ declarations do.  This brings
attributes.pm in line with them.

See commits fff96ff and 885ef6f, ticket #68758, and
<364E1F98-FDCC-49A7-BADB-BD844626B8AE@cpan.org>.

1 files changed, 31 insertions, 0 deletions

diff --git a/t/op/attrs.t b/t/op/attrs.t
index c0225c7be6..2567fa9082 100644
--- a/t/op/attrs.t
+++ b/t/op/attrs.t
@@ -332,4 +332,35 @@ foreach my $test (@tests) {
   ::is "@go", 'jabber joo', 'list assignment to array with attrs';
 }
 
+{
+  my $w;
+  local $SIG{__WARN__} = sub { $w = shift };
+  sub  ent         {}
+  sub lent :lvalue {}
+  my $posmsg =
+      'lvalue attribute ignored after the subroutine has been defined at '
+     .'\(eval';
+  my $negmsg =
+      'lvalue attribute cannot be removed after the subroutine has been '
+     .'defined 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';
+  $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';
+  $w = '';
+  eval 'use attributes __PACKAGE__, \&ent, "-lvalue"; 1' or die;
+  is $w, "", 'no lvalue warning on def lvalue sub';
+  no warnings 'misc';
+  eval 'use attributes __PACKAGE__, \&ent, "lvalue"';
+  is $w, "", 'no lvalue warnings under no warnings misc';
+  eval 'use attributes __PACKAGE__, \&lent, "-lvalue"';
+  is $w, "", 'no -lvalue warnings under no warnings misc';
+}
+
 done_testing();