diff options
| -rw-r--r-- | ext/attrs/attrs.pm | 19 | ||||
| -rw-r--r-- | ext/attrs/attrs.xs | 6 | ||||
| -rwxr-xr-x | t/lib/thread.t | 7 | ||||
| -rwxr-xr-x | t/pragma/sub_lval.t | 46 |
4 files changed, 39 insertions, 39 deletions
diff --git a/ext/attrs/attrs.pm b/ext/attrs/attrs.pm index e97fa1ee39..cec5ea5fcd 100644 --- 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 a92922d497..4c00cd7cb2 100644 --- 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 3bca8ba726..6c25407853 100755 --- 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 c382ad52ae..e96c329d8e 100755 --- 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 $_ = $@; |