# Regression tests for attributes.pm and the C< : attrs> syntax.
-use warnings;
-
BEGIN {
+ if ($ENV{PERL_CORE_MINITEST}) {
+ print "1..0 # skip: miniperl can't load attributes\n";
+ exit 0;
+ }
chdir 't' if -d 't';
@INC = '../lib';
require './test.pl';
}
-plan 83;
+use warnings;
+
+plan 90;
$SIG{__WARN__} = sub { die @_ };
is $@, '';
eval 'package Cat; my Cat @socks;';
-like $@, qr/^Can't declare class for non-scalar \@socks in "my"/;
+like $@, '';
+
+eval 'my Cat %nap;';
+like $@, '';
sub X::MODIFY_CODE_ATTRIBUTES { die "$_[0]" }
sub X::foo { 1 }
ok !defined(attributes::get(\PVBM)),
'PVBMs don\'t segfault attributes::get';
+
+# Test that code attributes always get applied to the same CV that
+# we're left with at the end (bug#66970).
+{
+ package bug66970;
+ our $c;
+ sub MODIFY_CODE_ATTRIBUTES { $c = $_[1]; () }
+ $c=undef; eval 'sub t0 :Foo';
+ main::ok $c == \&{"t0"};
+ $c=undef; eval 'sub t1 :Foo { }';
+ main::ok $c == \&{"t1"};
+ $c=undef; eval 'sub t2';
+ our $t2a = \&{"t2"};
+ $c=undef; eval 'sub t2 :Foo';
+ main::ok $c == \&{"t2"} && $c == $t2a;
+ $c=undef; eval 'sub t3';
+ our $t3a = \&{"t3"};
+ $c=undef; eval 'sub t3 :Foo { }';
+ main::ok $c == \&{"t3"} && $c == $t3a;
+ $c=undef; eval 'sub t4 :Foo';
+ our $t4a = \&{"t4"};
+ our $t4b = $c;
+ $c=undef; eval 'sub t4 :Foo';
+ main::ok $c == \&{"t4"} && $c == $t4b && $c == $t4a;
+ $c=undef; eval 'sub t5 :Foo';
+ our $t5a = \&{"t5"};
+ our $t5b = $c;
+ $c=undef; eval 'sub t5 :Foo { }';
+ main::ok $c == \&{"t5"} && $c == $t5b && $c == $t5a;
+}