diff options
| -rw-r--r-- | dist/Attribute-Handlers/lib/Attribute/Handlers.pm | 8 | ||||
| -rw-r--r-- | dist/threads/t/problems.t | 52 | ||||
| -rw-r--r-- | dist/threads/t/unique.t | 81 | ||||
| -rw-r--r-- | ext/attributes/attributes.pm | 12 | ||||
| -rw-r--r-- | pod/perldiag.pod | 7 | ||||
| -rw-r--r-- | t/lib/warnings/toke | 3 | ||||
| -rw-r--r-- | t/op/attrs.t | 6 | ||||
| -rw-r--r-- | toke.c | 12 |
8 files changed, 93 insertions, 88 deletions
diff --git a/dist/Attribute-Handlers/lib/Attribute/Handlers.pm b/dist/Attribute-Handlers/lib/Attribute/Handlers.pm index 7c049d48e6..710fe0839d 100644 --- a/dist/Attribute-Handlers/lib/Attribute/Handlers.pm +++ b/dist/Attribute-Handlers/lib/Attribute/Handlers.pm @@ -4,7 +4,7 @@ use Carp; use warnings; use strict; use vars qw($VERSION $AUTOLOAD); -$VERSION = '0.99'; # remember to update version in POD! +$VERSION = '1.00'; # remember to update version in POD! # $DB::single=1; my %symcache; @@ -139,7 +139,9 @@ sub AUTOLOAD { croak "Attribute handler '$2' doesn't handle $1 attributes"; } -my $builtin = qr/lvalue|method|locked|unique|shared/; +my $builtin = $] ge '5.027000' + ? qr/lvalue|method|locked|shared/ + : qr/lvalue|method|locked|shared|unique/; sub _gen_handler_AH_() { return sub { @@ -270,7 +272,7 @@ Attribute::Handlers - Simpler definition of attribute handlers =head1 VERSION -This document describes version 0.99 of Attribute::Handlers. +This document describes version 1.00 of Attribute::Handlers. =head1 SYNOPSIS diff --git a/dist/threads/t/problems.t b/dist/threads/t/problems.t index 3f28c0f3b5..3657d3403e 100644 --- a/dist/threads/t/problems.t +++ b/dist/threads/t/problems.t @@ -21,18 +21,14 @@ BEGIN { $| = 1; if ($] == 5.008) { - print("1..11\n"); ### Number of tests that will be run ### + print("1..6\n"); ### Number of tests that will be run ### } else { - print("1..15\n"); ### Number of tests that will be run ### + print("1..10\n"); ### Number of tests that will be run ### } }; print("ok 1 - Loaded\n"); -### Start of Testing ### - -no warnings 'deprecated'; # Suppress warnings related to :unique - use Hash::Util 'lock_keys'; my $test :shared = 2; @@ -93,50 +89,6 @@ if ($] != 5.008) } -# bugid 24383 - :unique hashes weren't being made readonly on interpreter -# clone; check that they are. - -our $unique_scalar : unique; -our @unique_array : unique; -our %unique_hash : unique; -threads->create(sub { - lock($test); - my $TODO = ":unique needs to be re-implemented in a non-broken way"; - eval { $unique_scalar = 1 }; - print $@ =~ /read-only/ - ? '' : 'not ', "ok $test # TODO $TODO - unique_scalar\n"; - $test++; - eval { $unique_array[0] = 1 }; - print $@ =~ /read-only/ - ? '' : 'not ', "ok $test # TODO $TODO - unique_array\n"; - $test++; - if ($] >= 5.008003 && $^O ne 'MSWin32') { - eval { $unique_hash{abc} = 1 }; - print $@ =~ /disallowed/ - ? '' : 'not ', "ok $test # TODO $TODO - unique_hash\n"; - } else { - print("ok $test # SKIP $TODO - unique_hash\n"); - } - $test++; - })->join; - -# bugid #24940 :unique should fail on my and sub declarations - -for my $decl ('my $x : unique', 'sub foo : unique') { - { - lock($test); - if ($] >= 5.008005) { - eval $decl; - print $@ =~ /^The 'unique' attribute may only be applied to 'our' variables/ - ? '' : 'not ', "ok $test - $decl\n"; - } else { - print("ok $test # SKIP $decl\n"); - } - $test++; - } -} - - # Returning a closure from a thread caused problems. If the last index in # the anon sub's pad wasn't for a lexical, then a core dump could occur. # Otherwise, there might be leaked scalars. diff --git a/dist/threads/t/unique.t b/dist/threads/t/unique.t new file mode 100644 index 0000000000..a9cfdbbcd2 --- /dev/null +++ b/dist/threads/t/unique.t @@ -0,0 +1,81 @@ +use strict; +use warnings; + +BEGIN { + use Config; + if (! $Config{'useithreads'}) { + print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); + exit(0); + } + if ($] >= 5.027000) { + print("1..0 # SKIP 'unique' attribute no longer exists\n"); + exit(0); + } +} + +use ExtUtils::testlib; + +use threads; + +BEGIN { + if (! eval 'use threads::shared; 1') { + print("1..0 # SKIP threads::shared not available\n"); + exit(0); + } + + $| = 1; + print("1..6\n") ; ### Number of tests that will be run ### +} + +print("ok 1 - Loaded\n"); + +### Start of Testing ### + +no warnings 'deprecated'; # Suppress warnings related to :unique + +my $test :shared = 2; + +# bugid 24383 - :unique hashes weren't being made readonly on interpreter +# clone; check that they are. + +our $unique_scalar : unique; +our @unique_array : unique; +our %unique_hash : unique; +threads->create(sub { + lock($test); + my $TODO = ":unique needs to be re-implemented in a non-broken way"; + eval { $unique_scalar = 1 }; + print $@ =~ /read-only/ + ? '' : 'not ', "ok $test # TODO $TODO - unique_scalar\n"; + $test++; + eval { $unique_array[0] = 1 }; + print $@ =~ /read-only/ + ? '' : 'not ', "ok $test # TODO $TODO - unique_array\n"; + $test++; + if ($] >= 5.008003 && $^O ne 'MSWin32') { + eval { $unique_hash{abc} = 1 }; + print $@ =~ /disallowed/ + ? '' : 'not ', "ok $test # TODO $TODO - unique_hash\n"; + } else { + print("ok $test # SKIP $TODO - unique_hash\n"); + } + $test++; + })->join; + +# bugid #24940 :unique should fail on my and sub declarations + +for my $decl ('my $x : unique', 'sub foo : unique') { + { + lock($test); + if ($] >= 5.008005) { + eval $decl; + print $@ =~ /^The 'unique' attribute may only be applied to 'our' variables/ + ? '' : 'not ', "ok $test - $decl\n"; + } else { + print("ok $test # SKIP $decl\n"); + } + $test++; + } +} + + diff --git a/ext/attributes/attributes.pm b/ext/attributes/attributes.pm index 7eb8e30ed8..85ec9ce4cb 100644 --- a/ext/attributes/attributes.pm +++ b/ext/attributes/attributes.pm @@ -1,6 +1,6 @@ package attributes; -our $VERSION = 0.29; +our $VERSION = 0.30; @EXPORT_OK = qw(get reftype); @EXPORT = (); @@ -20,8 +20,6 @@ sub carp { my %deprecated; $deprecated{CODE} = qr/\A-?(locked)\z/; -$deprecated{ARRAY} = $deprecated{HASH} = $deprecated{SCALAR} - = qr/\A-?(unique)\z/; my %msg = ( lvalue => 'lvalue attribute applied to already-defined subroutine', @@ -280,14 +278,6 @@ The following are the built-in attributes for variables: Indicates that the referenced variable can be shared across different threads when used in conjunction with the L<threads> and L<threads::shared> modules. -=item unique - -The "unique" attribute is deprecated, and has no effect in 5.10.0 and later. -It used to indicate that a single copy of an C<our> variable was to be used by -all interpreters should the program happen to be running in a -multi-interpreter environment. It will disappear in 5.28, after which its -use will be fatal. - =back =head2 Available Subroutines diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 730010a882..25f4c68efa 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -431,13 +431,6 @@ will be removed in a Perl 5.28. example. Since each sub can only have one prototype, the earlier declaration(s) are discarded while the last one is applied. -=item Attribute "unique" is deprecated, and will disappear in Perl 5.28 - -(D deprecated) You have used the attributes pragma to modify -the "unique" attribute on an array, hash or scalar reference. -The :unique attribute has had no effect since Perl 5.8.8, and -will be removed in a Perl 5.28. - =item av_reify called on tied array (S debugging) This indicates that something went wrong and Perl got I<very> diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke index 77e0ae335a..564174c5e6 100644 --- a/t/lib/warnings/toke +++ b/t/lib/warnings/toke @@ -1250,21 +1250,18 @@ EXPECT !=~ should be !~ at - line 9. ######## # toke.c -our $foo :unique; sub pam :locked; sub glipp :locked { } sub whack_eth ($) : locked { } no warnings 'deprecated'; -our $bar :unique; sub zapeth :locked; sub ker_plop :locked { } sub swa_a_p ($) : locked { } EXPECT -Attribute "unique" is deprecated, and will disappear in Perl 5.28 at - line 2. Attribute "locked" is deprecated, and will disappear in Perl 5.28 at - line 3. Attribute "locked" is deprecated, and will disappear in Perl 5.28 at - line 4. Attribute "locked" is deprecated, and will disappear in Perl 5.28 at - line 6. diff --git a/t/op/attrs.t b/t/op/attrs.t index c3cf439f1f..eb31b181fe 100644 --- a/t/op/attrs.t +++ b/t/op/attrs.t @@ -160,20 +160,20 @@ like $@, qr/Can't declare scalar dereference in "my"/; my @code = qw(lvalue method); my @other = qw(shared); -my @deprecated = qw(locked unique); +my @deprecated = qw(locked); +my @invalid = qw(unique); my %valid; $valid{CODE} = {map {$_ => 1} @code}; $valid{SCALAR} = {map {$_ => 1} @other}; $valid{ARRAY} = $valid{HASH} = $valid{SCALAR}; my %deprecated; $deprecated{CODE} = { locked => 1 }; -$deprecated{ARRAY} = $deprecated{HASH} = $deprecated{SCALAR} = { unique => 1 }; our ($scalar, @array, %hash); foreach my $value (\&foo, \$scalar, \@array, \%hash) { my $type = ref $value; foreach my $negate ('', '-') { - foreach my $attr (@code, @other, @deprecated) { + foreach my $attr (@code, @other, @deprecated, @invalid) { my $attribute = $negate . $attr; eval "use attributes __PACKAGE__, \$value, '$attribute'"; if ($deprecated{$type}{$attr}) { @@ -5890,19 +5890,9 @@ Perl_yylex(pTHX) PL_lex_stuff = NULL; } else { - if (len == 6 && strnEQ(SvPVX(sv), "unique", len)) { - sv_free(sv); - if (PL_in_my == KEY_our) { - deprecate_disappears_in("5.28", - "Attribute \"unique\" is deprecated"); - } - else - Perl_croak(aTHX_ "The 'unique' attribute may only be applied to 'our' variables"); - } - /* NOTE: any CV attrs applied here need to be part of the CVf_BUILTIN_ATTRS define in cv.h! */ - else if (!PL_in_my && len == 6 && strnEQ(SvPVX(sv), "lvalue", len)) { + if (!PL_in_my && len == 6 && strnEQ(SvPVX(sv), "lvalue", len)) { sv_free(sv); CvLVALUE_on(PL_compcv); } |