deprecate C<use attrs>

p4raw-id: //depot/perl@4278

diff --git a/ext/attrs/attrs.pm b/ext/attrs/attrs.pm
index e97fa1e..cec5ea5 100644 (file)
--- a/ext/attrs/attrs.pm
+++ b/ext/attrs/attrs.pm
@@ -8,7 +8,7 @@ $VERSION = "1.0";
 
 =head1 NAME
 
-attrs - set/get attributes of a subroutine
+attrs - set/get attributes of a subroutine (deprecated)
 
 =head1 SYNOPSIS
 
@@ -21,11 +21,17 @@ attrs - set/get attributes of a subroutine
 
 =head1 DESCRIPTION
 
-This module lets you set and get attributes for subroutines.
+NOTE: Use of this pragma is deprecated.  Use the syntax
+
+    sub foo : locked, method { }
+
+to declare attributes instead.  See also L<attributes>.
+
+This pragma lets you set and get attributes for subroutines.
 Setting attributes takes place at compile time; trying to set
 invalid attribute names causes a compile-time error. Calling
-C<attr::get> on a subroutine reference or name returns its list
-of attribute names. Notice that C<attr::get> is not exported.
+C<attrs::get> on a subroutine reference or name returns its list
+of attribute names. Notice that C<attrs::get> is not exported.
 Valid attributes are as follows.
 
 =over
@@ -46,11 +52,6 @@ execution. The semantics of the lock are exactly those of one
 explicitly taken with the C<lock> operator immediately after the
 subroutine is entered.
 
-=item lvalue
-
-Setting this attribute enables the subroutine to be used in
-lvalue context.  See L<perlsub/"Lvalue subroutines">.
-
 =back
 
 =cut

diff --git a/ext/attrs/attrs.xs b/ext/attrs/attrs.xs
index a92922d..4c00cd7 100644 (file)
--- a/ext/attrs/attrs.xs
+++ b/ext/attrs/attrs.xs
@@ -10,8 +10,6 @@ get_flag(char *attr)
        return CVf_METHOD;
     else if (strnEQ(attr, "locked", 6))
        return CVf_LOCKED;
-    else if (strnEQ(attr, "lvalue", 6))
-       return CVf_LVALUE;
     else
        return 0;
 }
@@ -29,6 +27,10 @@ char *       Class
     PPCODE:
        if (!PL_compcv || !(cv = CvOUTSIDE(PL_compcv)))
            croak("can't set attributes outside a subroutine scope");
+       if (ckWARN(WARN_DEPRECATED))
+           Perl_warner(aTHX_ WARN_DEPRECATED,
+                       "pragma \"attrs\" is deprecated, "
+                       "use \"sub NAME : ATTRS\" instead");
        for (i = 1; i < items; i++) {
            STRLEN n_a;
            char *attr = SvPV(ST(i), n_a);

diff --git a/t/lib/thread.t b/t/lib/thread.t
index 3bca8ba..6c25407 100755 (executable)
--- a/t/lib/thread.t
+++ b/t/lib/thread.t
@@ -55,9 +55,7 @@ sleep 6;
 print "ok 12\n";
 $t->join;
 
-sub islocked
-{
- use attrs 'locked';
+sub islocked : locked {
  my $val = shift;
  my $ret;
  print $val;
@@ -74,8 +72,7 @@ $t->join->join;
 {
     package Loch::Ness;
     sub new { bless [], shift }
-    sub monster {
-       use attrs qw(locked method);
+    sub monster : locked, method {
        my($s, $m) = @_;
        print "ok $m\n";
     }

diff --git a/t/pragma/sub_lval.t b/t/pragma/sub_lval.t
index c382ad5..e96c329 100755 (executable)
--- a/t/pragma/sub_lval.t
+++ b/t/pragma/sub_lval.t
@@ -5,8 +5,8 @@ BEGIN {
     unshift @INC, '../lib';
 }
 
-sub a {use attrs 'lvalue'; my $a = 34; bless \$a}  # Return a temporary
-sub b {use attrs 'lvalue'; shift}
+sub a : lvalue { my $a = 34; bless \$a }  # Return a temporary
+sub b : lvalue { shift }
 
 my $out = a(b());              # Check that temporaries are allowed.
 print "# `$out'\nnot " unless ref $out eq 'main'; # Not reached if error.
@@ -20,8 +20,8 @@ my $in;
 
 # Check that we can return localized values from subroutines:
 
-sub in {use attrs 'lvalue'; $in = shift;}
-sub neg {use attrs 'lvalue';  #(num_str) return num_str
+sub in : lvalue { $in = shift; }
+sub neg : lvalue {  #(num_str) return num_str
     local $_ = shift;
     s/^\+/-/;
     $_;
@@ -32,11 +32,11 @@ in(neg("+2"));
 print "# `$in'\nnot " unless $in eq '-2';
 print "ok 3\n";
 
-sub get_lex {use attrs 'lvalue'; $in}
-sub get_st {use attrs 'lvalue'; $blah}
-sub id {use attrs 'lvalue'; shift}
-sub id1 {use attrs 'lvalue'; $_[0]}
-sub inc {use attrs 'lvalue'; ++$_[0]}
+sub get_lex : lvalue { $in }
+sub get_st : lvalue { $blah }
+sub id : lvalue { shift }
+sub id1 : lvalue { $_[0] }
+sub inc : lvalue { ++$_[0] }
 
 $in = 5;
 $blah = 3;
@@ -139,9 +139,9 @@ $#c = 3;                    # These slots are not fillable.
 
 =for disabled constructs
 
-sub a3 {use attrs 'lvalue'; @a}
-sub b2 {use attrs 'lvalue'; @b}
-sub c4 {use attrs 'lvalue'; @c}
+sub a3 :lvalue {@a}
+sub b2 : lvalue {@b}
+sub c4: lvalue {@c}
 
 $_ = '';
 
@@ -162,7 +162,7 @@ print "ok 22\n";
 
 my $var;
 
-sub a::var {use attrs 'lvalue'; $var}
+sub a::var : lvalue { $var }
 
 "a"->var = 45;
 
@@ -177,7 +177,7 @@ $o->var = 47;
 print "# `$var' ne 47\nnot " unless $var eq 47;
 print "ok 24\n";
 
-sub o {use attrs 'lvalue'; $o}
+sub o : lvalue { $o }
 
 o->var = 49;
 
@@ -242,7 +242,7 @@ print "# '$_', '$x0', '$x1'.\nnot "
   unless /Can\'t modify non-lvalue subroutine call/;
 print "ok 30\n";
 
-sub lv0 {use attrs 'lvalue';}          # Converted to lv10 in scalar context
+sub lv0 : lvalue { }           # Converted to lv10 in scalar context
 
 $_ = undef;
 eval <<'EOE' or $_ = $@;
@@ -254,7 +254,7 @@ print "# '$_'.\nnot "
   unless /Can\'t return a readonly value from lvalue subroutine/;
 print "ok 31\n";
 
-sub lv10 {use attrs 'lvalue';}
+sub lv10 : lvalue {}
 
 $_ = undef;
 eval <<'EOE' or $_ = $@;
@@ -265,7 +265,7 @@ EOE
 print "# '$_'.\nnot " if defined $_;
 print "ok 32\n";
 
-sub lv1u {use attrs 'lvalue'; undef }
+sub lv1u :lvalue { undef }
 
 $_ = undef;
 eval <<'EOE' or $_ = $@;
@@ -288,7 +288,7 @@ print "# '$_'.\nnot "
 print "ok 34\n";
 
 $x = '1234567';
-sub lv1t {use attrs 'lvalue'; index $x, 2 }
+sub lv1t : lvalue { index $x, 2 }
 
 $_ = undef;
 eval <<'EOE' or $_ = $@;
@@ -312,7 +312,7 @@ print "ok 36\n";
 
 $xxx = 'xxx';
 sub xxx () { $xxx }  # Not lvalue
-sub lv1tmp {use attrs 'lvalue'; xxx }                  # is it a TEMP?
+sub lv1tmp : lvalue { xxx }                    # is it a TEMP?
 
 $_ = undef;
 eval <<'EOE' or $_ = $@;
@@ -335,7 +335,7 @@ print "# '$_'.\nnot "
 print "ok 38\n";
 
 sub xxx () { 'xxx' } # Not lvalue
-sub lv1tmpr {use attrs 'lvalue'; xxx }                 # is it a TEMP?
+sub lv1tmpr : lvalue { xxx }                   # is it a TEMP?
 
 $_ = undef;
 eval <<'EOE' or $_ = $@;
@@ -359,7 +359,7 @@ print "ok 40\n";
 
 =for disabled constructs
 
-sub lva {use attrs 'lvalue';@a}
+sub lva : lvalue {@a}
 
 $_ = undef;
 @a = ();
@@ -401,7 +401,7 @@ print "ok 43\n";
 
 print "ok $_\n" for 41..43;
 
-sub lv1n {use attrs 'lvalue'; $newvar }
+sub lv1n : lvalue { $newvar }
 
 $_ = undef;
 eval <<'EOE' or $_ = $@;
@@ -412,7 +412,7 @@ EOE
 print "# '$_', '$newvar'.\nnot " unless "'$newvar' $_" eq "'4' ";
 print "ok 44\n";
 
-sub lv1nn {use attrs 'lvalue'; $nnewvar }
+sub lv1nn : lvalue { $nnewvar }
 
 $_ = undef;
 eval <<'EOE' or $_ = $@;