[perl5.git] / t / op / attrs.t

#!./perl

# Regression tests for attributes.pm and the C< : attrs> syntax.

BEGIN {
    chdir 't' if -d 't';
    @INC = '../lib';
    require './test.pl';
    skip_all_if_miniperl("miniperl can't load attributes");
}

use warnings;

$SIG{__WARN__} = sub { die @_ };

sub eval_ok ($;$) {
    eval shift;
    is( $@, '', @_);
}

our $anon1; eval_ok '$anon1 = sub : method { $_[0]++ }';

eval 'sub e1 ($) : plugh ;';
like $@, qr/^Invalid CODE attributes?: ["']?plugh["']? at/;

eval 'sub e2 ($) : plugh(0,0) xyzzy ;';
like $@, qr/^Invalid CODE attributes: ["']?plugh\(0,0\)["']? /;

eval 'sub e3 ($) : plugh(0,0 xyzzy ;';
like $@, qr/Unterminated attribute parameter in attribute list at/;

eval 'sub e4 ($) : plugh + XYZZY ;';
like $@, qr/Invalid separator character '[+]' in attribute list at/;

eval_ok 'my main $x : = 0;';
eval_ok 'my $x : = 0;';
eval_ok 'my $x ;';
eval_ok 'my ($x) : = 0;';
eval_ok 'my ($x) ;';
eval_ok 'my ($x) : ;';
eval_ok 'my ($x,$y) : = 0;';
eval_ok 'my ($x,$y) ;';
eval_ok 'my ($x,$y) : ;';

eval 'my ($x,$y) : plugh;';
like $@, qr/^Invalid SCALAR attribute: ["']?plugh["']? at/;

# bug #16080
eval '{my $x : plugh}';
like $@, qr/^Invalid SCALAR attribute: ["']?plugh["']? at/;
eval '{my ($x,$y) : plugh(})}';
like $@, qr/^Invalid SCALAR attribute: ["']?plugh\(}\)["']? at/;

# More syntax tests from the attributes manpage
eval 'my $x : switch(10,foo(7,3))  :  expensive;';
like $@, qr/^Invalid SCALAR attributes: ["']?switch\(10,foo\(7,3\)\) : expensive["']? at/;
eval q/my $x : Ugly('\(") :Bad;/;
like $@, qr/^Invalid SCALAR attributes: ["']?Ugly\('\\\("\) : Bad["']? at/;
eval 'my $x : _5x5;';
like $@, qr/^Invalid SCALAR attribute: ["']?_5x5["']? at/;
eval 'my $x : locked method;';
like $@, qr/^Invalid SCALAR attributes: ["']?locked : method["']? at/;
eval 'my $x : switch(10,foo();';
like $@, qr/^Unterminated attribute parameter in attribute list at/;
eval q/my $x : Ugly('(');/;
like $@, qr/^Unterminated attribute parameter in attribute list at/;
eval 'my $x : 5x5;';
like $@, qr/error/;
eval 'my $x : Y2::north;';
like $@, qr/Invalid separator character ':' in attribute list at/;

sub A::MODIFY_SCALAR_ATTRIBUTES { return }
eval 'my A $x : plugh;';
like $@, qr/^SCALAR package attribute may clash with future reserved word: ["']?plugh["']? at/;

eval 'my A $x : plugh plover;';
like $@, qr/^SCALAR package attributes may clash with future reserved words: ["']?plugh["']? /;

no warnings 'reserved';
eval 'my A $x : plugh;';
is $@, '';

eval 'package Cat; my Cat @socks;';
like $@, '';

eval 'my Cat %nap;';
like $@, '';

sub X::MODIFY_CODE_ATTRIBUTES { die "$_[0]" }
sub X::foo { 1 }
*Y::bar = \&X::foo;
*Y::bar = \&X::foo;	# second time for -w
eval 'package Z; sub Y::bar : foo';
like $@, qr/^X at /;

@attrs = eval 'attributes::get $anon1';
is "@attrs", "method";

sub Z::DESTROY { }
sub Z::FETCH_CODE_ATTRIBUTES { return 'Z' }
my $thunk = eval 'bless +sub : method { 1 }, "Z"';
is ref($thunk), "Z";

@attrs = eval 'attributes::get $thunk';
is "@attrs", "method Z";

# Test attributes on predeclared subroutines:
eval 'package A; sub PS : lvalue';
@attrs = eval 'attributes::get \&A::PS';
is "@attrs", "lvalue";

# Test attributes on predeclared subroutines, after definition
eval 'package A; sub PS : lvalue; sub PS { }';
@attrs = eval 'attributes::get \&A::PS';
is "@attrs", "lvalue";

# Test ability to modify existing sub's (or XSUB's) attributes.
eval 'package A; sub X { $_[0] } sub X : method';
@attrs = eval 'attributes::get \&A::X';
is "@attrs", "method";

# Above not with just 'pure' built-in attributes.
sub Z::MODIFY_CODE_ATTRIBUTES { (); }
eval 'package Z; sub L { $_[0] } sub L : Z method';
@attrs = eval 'attributes::get \&Z::L';
is "@attrs", "method Z";

# Begin testing attributes that tie

{
    package Ttie;
    sub DESTROY {}
    sub TIESCALAR { my $x = $_[1]; bless \$x, $_[0]; }
    sub FETCH { ${$_[0]} }
    sub STORE {
	::pass;
	${$_[0]} = $_[1]*2;
    }
    package Tloop;
    sub MODIFY_SCALAR_ATTRIBUTES { tie ${$_[1]}, 'Ttie', -1; (); }
}

eval_ok '
    package Tloop;
    for my $i (0..2) {
	my $x : TieLoop = $i;
	$x != $i*2 and ::is $x, $i*2;
    }
';

# bug #15898
eval 'our ${""} : foo = 1';
like $@, qr/Can't declare scalar dereference in "our"/;
eval 'my $$foo : bar = 1';
like $@, qr/Can't declare scalar dereference in "my"/;


my @code = qw(lvalue method);
my @other = qw(shared);
my @deprecated = qw(locked 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) {
	    my $attribute = $negate . $attr;
	    eval "use attributes __PACKAGE__, \$value, '$attribute'";
	    if ($deprecated{$type}{$attr}) {
		like $@, qr/^Attribute "$attr" is deprecated at \(eval \d+\)/,
		    "$type attribute $attribute deprecated";
	    } elsif ($valid{$type}{$attr}) {
		if ($attribute eq '-shared') {
		    like $@, qr/^A variable may not be unshared/;
		} else {
		    is( $@, '', "$type attribute $attribute");
		}
	    } else {
		like $@, qr/^Invalid $type attribute: $attribute/,
		    "Bogus $type attribute $attribute should fail";
	    }
	}
    }
}

# this will segfault if it fails
sub PVBM () { 'foo' }
{ my $dummy = index 'foo', PVBM }

ok !defined(attributes::get(\PVBM)), 
    'PVBMs don\'t segfault attributes::get';

{
    #  [perl #49472] Attributes + Unknown Error
    eval '
	use strict;
	sub MODIFY_CODE_ATTRIBUTE{}
	sub f:Blah {$nosuchvar};
    ';

    my $err = $@;
    like ($err, qr/Global symbol "\$nosuchvar" requires /, 'perl #49472');
}

# 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;
}

my @tests = grep {/^[^#]/} split /\n/, <<'EOT';
# This one is fine as an empty attribute list
my $holy_Einstein : = '';
# This one is deprecated
my $krunch := 4;
our $FWISK_FWISK_FWIZZACH_FWACH_ZACHITTY_ZICH_SHAZZATZ_FWISK := '';
state $thump := 'Trumpets';
# Lather rinse repeat in my usual obsessive style
my @holy_perfect_pitch : = ();
my @zok := ();
our @GUKGUK := ();
# state @widget_mark := ();
my %holy_seditives : = ();
my %bang := ();
our %GIGAZING := ();
# state %hex := ();
my $holy_giveaways : = '';
my $eee_yow := [];
our $TWOYYOYYOING_THUK_UGH := 1 == 1;
state $octothorn := 'Tinky Winky';
my @holy_Taj_Mahal : = ();
my @touche := ();
our @PLAK_DAK_THUK_FRIT := ();
# state @hash_mark := ();
my %holy_priceless_collection_of_Etruscan_snoods : = ();
my %wham_eth := ();
our %THWUK := ();
# state %octalthorpe := ();
my $holy_sewer_pipe : = '';
my $thunk := undef;
our $BLIT := time;
state $crunch := 'Laa Laa';
my @glurpp := ();
my @holy_harem : = ();
our @FABADAP := ();
# state @square := ();
my %holy_pin_cushions : = ();
my %swoosh := ();
our %RRRRR := ();
# state %scratchmark := ();
EOT

foreach my $test (@tests) {
    use feature 'state';
    eval $test;
    if ($test =~ /:=/) {
	like $@, qr/Use of := for an empty attribute list is not allowed/,
	    "Parse error for q{$test}";
    } else {
	is $@, '', "No error for q{$test}";
    }
}

# [perl #68560] Calling closure prototypes (only accessible via :attr)
{
  package brength;
  my $proto;
  sub MODIFY_CODE_ATTRIBUTES { $proto = $_[1]; _: }
  eval q{
     my $x;
     () = sub :a0 { $x };
  };
  package main;
  eval { $proto->() };               # used to crash in pp_entersub
  like $@, qr/^Closure prototype called/,
     "Calling closure proto with (no) args";
  eval { () = &$proto };             # used to crash in pp_leavesub
  like $@, qr/^Closure prototype called/,
     'Calling closure proto with no @_ that returns a lexical';
}

# [perl #68658] Attributes on stately variables
{
  package thwext;
  sub MODIFY_SCALAR_ATTRIBUTES { () }
  my $i = 0;
  my $x_values = '';
  eval 'sub foo { use 5.01; state $x :A0 = $i++; $x_values .= $x }';
  foo(); foo();
  package main;
  is $x_values, '00', 'state with attributes';
}

done_testing();
Commit	Line	Data
9c6390c7	1	#!./perl
09bef843 SB	2
	3	# Regression tests for attributes.pm and the C< : attrs> syntax.
	4
	5	BEGIN {
	6	chdir 't' if -d 't';
20822f61	7	@INC = '../lib';
1ce0b88c	8	require './test.pl';
62e452a4	9	skip_all_if_miniperl("miniperl can't load attributes");
09bef843 SB	10	}
09bef843 SB	11
98d0ccc7 RGS	12	use warnings;
98d0ccc7 RGS	13
09bef843 SB	14	$SIG{__WARN__} = sub { die @_ };
09bef843 SB	15
42262798 NC	16	sub eval_ok ($;$) {
	17	eval shift;
	18	is( $@, '', @_);
09bef843 SB	19	}
09bef843 SB	20
8e5dadda	21	our $anon1; eval_ok '$anon1 = sub : method { $_[0]++ }';
09bef843 SB	22
09bef843 SB	23	eval 'sub e1 ($) : plugh ;';
1ce0b88c	24	like $@, qr/^Invalid CODE attributes?: ["']?plugh["']? at/;
09bef843 SB	25
09bef843 SB	26	eval 'sub e2 ($) : plugh(0,0) xyzzy ;';
1ce0b88c	27	like $@, qr/^Invalid CODE attributes: ["']?plugh\(0,0\)["']? /;
09bef843 SB	28
09bef843 SB	29	eval 'sub e3 ($) : plugh(0,0 xyzzy ;';
1ce0b88c	30	like $@, qr/Unterminated attribute parameter in attribute list at/;
09bef843	31
5f211341	32	eval 'sub e4 ($) : plugh + XYZZY ;';
1ce0b88c RGS	33	like $@, qr/Invalid separator character '[+]' in attribute list at/;
	34
	35	eval_ok 'my main $x : = 0;';
	36	eval_ok 'my $x : = 0;';
	37	eval_ok 'my $x ;';
	38	eval_ok 'my ($x) : = 0;';
	39	eval_ok 'my ($x) ;';
	40	eval_ok 'my ($x) : ;';
	41	eval_ok 'my ($x,$y) : = 0;';
	42	eval_ok 'my ($x,$y) ;';
	43	eval_ok 'my ($x,$y) : ;';
09bef843 SB	44
09bef843 SB	45	eval 'my ($x,$y) : plugh;';
1ce0b88c	46	like $@, qr/^Invalid SCALAR attribute: ["']?plugh["']? at/;
09bef843	47
8e7ae056 RGS	48	# bug #16080
	49	eval '{my $x : plugh}';
	50	like $@, qr/^Invalid SCALAR attribute: ["']?plugh["']? at/;
	51	eval '{my ($x,$y) : plugh(})}';
	52	like $@, qr/^Invalid SCALAR attribute: ["']?plugh\(}\)["']? at/;
	53
c9124e92 RGS	54	# More syntax tests from the attributes manpage
	55	eval 'my $x : switch(10,foo(7,3)) : expensive;';
	56	like $@, qr/^Invalid SCALAR attributes: ["']?switch\(10,foo\(7,3\)\) : expensive["']? at/;
	57	eval q/my $x : Ugly('\(") :Bad;/;
	58	like $@, qr/^Invalid SCALAR attributes: ["']?Ugly\('\\\("\) : Bad["']? at/;
	59	eval 'my $x : _5x5;';
	60	like $@, qr/^Invalid SCALAR attribute: ["']?_5x5["']? at/;
	61	eval 'my $x : locked method;';
	62	like $@, qr/^Invalid SCALAR attributes: ["']?locked : method["']? at/;
	63	eval 'my $x : switch(10,foo();';
	64	like $@, qr/^Unterminated attribute parameter in attribute list at/;
	65	eval q/my $x : Ugly('(');/;
	66	like $@, qr/^Unterminated attribute parameter in attribute list at/;
	67	eval 'my $x : 5x5;';
	68	like $@, qr/error/;
	69	eval 'my $x : Y2::north;';
	70	like $@, qr/Invalid separator character ':' in attribute list at/;
	71
09bef843 SB	72	sub A::MODIFY_SCALAR_ATTRIBUTES { return }
09bef843 SB	73	eval 'my A $x : plugh;';
1ce0b88c	74	like $@, qr/^SCALAR package attribute may clash with future reserved word: ["']?plugh["']? at/;
09bef843 SB	75
09bef843 SB	76	eval 'my A $x : plugh plover;';
1ce0b88c	77	like $@, qr/^SCALAR package attributes may clash with future reserved words: ["']?plugh["']? /;
09bef843	78
9c6390c7 RGS	79	no warnings 'reserved';
	80	eval 'my A $x : plugh;';
	81	is $@, '';
	82
3f8f4626	83	eval 'package Cat; my Cat @socks;';
d5e98372 VP	84	like $@, '';
	85
	86	eval 'my Cat %nap;';
	87	like $@, '';
3f8f4626	88
09bef843 SB	89	sub X::MODIFY_CODE_ATTRIBUTES { die "$_[0]" }
	90	sub X::foo { 1 }
	91	*Y::bar = \&X::foo;
	92	*Y::bar = \&X::foo; # second time for -w
0256094b	93	eval 'package Z; sub Y::bar : foo';
1ce0b88c	94	like $@, qr/^X at /;
09bef843	95
09bef843	96	@attrs = eval 'attributes::get $anon1';
8e5dadda	97	is "@attrs", "method";
09bef843 SB	98
	99	sub Z::DESTROY { }
	100	sub Z::FETCH_CODE_ATTRIBUTES { return 'Z' }
8e5dadda	101	my $thunk = eval 'bless +sub : method { 1 }, "Z"';
1ce0b88c	102	is ref($thunk), "Z";
09bef843 SB	103
09bef843 SB	104	@attrs = eval 'attributes::get $thunk';
8e5dadda	105	is "@attrs", "method Z";
09bef843	106
61dbb99a SF	107	# Test attributes on predeclared subroutines:
	108	eval 'package A; sub PS : lvalue';
	109	@attrs = eval 'attributes::get \&A::PS';
	110	is "@attrs", "lvalue";
	111
eac910c8 GG	112	# Test attributes on predeclared subroutines, after definition
	113	eval 'package A; sub PS : lvalue; sub PS { }';
	114	@attrs = eval 'attributes::get \&A::PS';
	115	is "@attrs", "lvalue";
	116
d3cea301	117	# Test ability to modify existing sub's (or XSUB's) attributes.
885ef6f5	118	eval 'package A; sub X { $_[0] } sub X : method';
d3cea301	119	@attrs = eval 'attributes::get \&A::X';
885ef6f5	120	is "@attrs", "method";
d3cea301	121
020f0e03 SB	122	# Above not with just 'pure' built-in attributes.
020f0e03 SB	123	sub Z::MODIFY_CODE_ATTRIBUTES { (); }
885ef6f5	124	eval 'package Z; sub L { $_[0] } sub L : Z method';
020f0e03	125	@attrs = eval 'attributes::get \&Z::L';
885ef6f5	126	is "@attrs", "method Z";
020f0e03	127
95f0a2f1 SB	128	# Begin testing attributes that tie
	129
	130	{
	131	package Ttie;
	132	sub DESTROY {}
	133	sub TIESCALAR { my $x = $_[1]; bless \$x, $_[0]; }
	134	sub FETCH { ${$_[0]} }
	135	sub STORE {
1ce0b88c	136	::pass;
95f0a2f1 SB	137	${$_[0]} = $_[1]*2;
	138	}
	139	package Tloop;
	140	sub MODIFY_SCALAR_ATTRIBUTES { tie ${$_[1]}, 'Ttie', -1; (); }
	141	}
	142
1ce0b88c	143	eval_ok '
95f0a2f1 SB	144	package Tloop;
	145	for my $i (0..2) {
	146	my $x : TieLoop = $i;
1ce0b88c	147	$x != $i2 and ::is $x, $i2;
95f0a2f1 SB	148	}
95f0a2f1 SB	149	';
09bef843	150
1ce0b88c RGS	151	# bug #15898
1ce0b88c RGS	152	eval 'our ${""} : foo = 1';
fab01b8e	153	like $@, qr/Can't declare scalar dereference in "our"/;
1ce0b88c	154	eval 'my $$foo : bar = 1';
fab01b8e	155	like $@, qr/Can't declare scalar dereference in "my"/;
42262798 NC	156
42262798 NC	157
c32124fe	158	my @code = qw(lvalue method);
f1a3ce43 NC	159	my @other = qw(shared);
f1a3ce43 NC	160	my @deprecated = qw(locked unique);
42262798 NC	161	my %valid;
	162	$valid{CODE} = {map {$_ => 1} @code};
	163	$valid{SCALAR} = {map {$_ => 1} @other};
	164	$valid{ARRAY} = $valid{HASH} = $valid{SCALAR};
c32124fe NC	165	my %deprecated;
c32124fe NC	166	$deprecated{CODE} = { locked => 1 };
f1a3ce43	167	$deprecated{ARRAY} = $deprecated{HASH} = $deprecated{SCALAR} = { unique => 1 };
42262798	168
adb2fcba	169	our ($scalar, @array, %hash);
42262798 NC	170	foreach my $value (\&foo, \$scalar, \@array, \%hash) {
	171	my $type = ref $value;
	172	foreach my $negate ('', '-') {
c32124fe	173	foreach my $attr (@code, @other, @deprecated) {
42262798 NC	174	my $attribute = $negate . $attr;
42262798 NC	175	eval "use attributes __PACKAGE__, \$value, '$attribute'";
c32124fe NC	176	if ($deprecated{$type}{$attr}) {
	177	like $@, qr/^Attribute "$attr" is deprecated at \(eval \d+\)/,
	178	"$type attribute $attribute deprecated";
	179	} elsif ($valid{$type}{$attr}) {
42262798 NC	180	if ($attribute eq '-shared') {
	181	like $@, qr/^A variable may not be unshared/;
	182	} else {
	183	is( $@, '', "$type attribute $attribute");
	184	}
	185	} else {
	186	like $@, qr/^Invalid $type attribute: $attribute/,
	187	"Bogus $type attribute $attribute should fail";
	188	}
	189	}
	190	}
	191	}
6e592b3a BM	192
	193	# this will segfault if it fails
	194	sub PVBM () { 'foo' }
	195	{ my $dummy = index 'foo', PVBM }
	196
	197	ok !defined(attributes::get(\PVBM)),
	198	'PVBMs don\'t segfault attributes::get';
09330df8	199
8314a0a6	200	{
93f09d7b	201	# [perl #49472] Attributes + Unknown Error
8314a0a6 NC	202	eval '
	203	use strict;
	204	sub MODIFY_CODE_ATTRIBUTE{}
	205	sub f:Blah {$nosuchvar};
	206	';
	207
	208	my $err = $@;
	209	like ($err, qr/Global symbol "\$nosuchvar" requires /, 'perl #49472');
	210	}
	211
09330df8 Z	212	# Test that code attributes always get applied to the same CV that
	213	# we're left with at the end (bug#66970).
	214	{
	215	package bug66970;
	216	our $c;
	217	sub MODIFY_CODE_ATTRIBUTES { $c = $_[1]; () }
	218	$c=undef; eval 'sub t0 :Foo';
	219	main::ok $c == \&{"t0"};
	220	$c=undef; eval 'sub t1 :Foo { }';
	221	main::ok $c == \&{"t1"};
	222	$c=undef; eval 'sub t2';
	223	our $t2a = \&{"t2"};
	224	$c=undef; eval 'sub t2 :Foo';
	225	main::ok $c == \&{"t2"} && $c == $t2a;
	226	$c=undef; eval 'sub t3';
	227	our $t3a = \&{"t3"};
	228	$c=undef; eval 'sub t3 :Foo { }';
	229	main::ok $c == \&{"t3"} && $c == $t3a;
	230	$c=undef; eval 'sub t4 :Foo';
	231	our $t4a = \&{"t4"};
	232	our $t4b = $c;
	233	$c=undef; eval 'sub t4 :Foo';
	234	main::ok $c == \&{"t4"} && $c == $t4b && $c == $t4a;
	235	$c=undef; eval 'sub t5 :Foo';
	236	our $t5a = \&{"t5"};
	237	our $t5b = $c;
	238	$c=undef; eval 'sub t5 :Foo { }';
	239	main::ok $c == \&{"t5"} && $c == $t5b && $c == $t5a;
	240	}
2dc78664 NC	241
	242	my @tests = grep {/^[^#]/} split /\n/, <<'EOT';
	243	# This one is fine as an empty attribute list
	244	my $holy_Einstein : = '';
	245	# This one is deprecated
	246	my $krunch := 4;
	247	our $FWISK_FWISK_FWIZZACH_FWACH_ZACHITTY_ZICH_SHAZZATZ_FWISK := '';
	248	state $thump := 'Trumpets';
	249	# Lather rinse repeat in my usual obsessive style
	250	my @holy_perfect_pitch : = ();
	251	my @zok := ();
	252	our @GUKGUK := ();
	253	# state @widget_mark := ();
	254	my %holy_seditives : = ();
	255	my %bang := ();
	256	our %GIGAZING := ();
	257	# state %hex := ();
	258	my $holy_giveaways : = '';
	259	my $eee_yow := [];
	260	our $TWOYYOYYOING_THUK_UGH := 1 == 1;
	261	state $octothorn := 'Tinky Winky';
	262	my @holy_Taj_Mahal : = ();
	263	my @touche := ();
	264	our @PLAK_DAK_THUK_FRIT := ();
	265	# state @hash_mark := ();
	266	my %holy_priceless_collection_of_Etruscan_snoods : = ();
	267	my %wham_eth := ();
	268	our %THWUK := ();
	269	# state %octalthorpe := ();
	270	my $holy_sewer_pipe : = '';
	271	my $thunk := undef;
	272	our $BLIT := time;
	273	state $crunch := 'Laa Laa';
	274	my @glurpp := ();
	275	my @holy_harem : = ();
	276	our @FABADAP := ();
	277	# state @square := ();
	278	my %holy_pin_cushions : = ();
	279	my %swoosh := ();
	280	our %RRRRR := ();
	281	# state %scratchmark := ();
	282	EOT
	283
	284	foreach my $test (@tests) {
	285	use feature 'state';
	286	eval $test;
	287	if ($test =~ /:=/) {
	288	like $@, qr/Use of := for an empty attribute list is not allowed/,
	289	"Parse error for q{$test}";
	290	} else {
	291	is $@, '', "No error for q{$test}";
	292	}
	293	}
	294
541ed3a9 FC	295	# [perl #68560] Calling closure prototypes (only accessible via :attr)
	296	{
	297	package brength;
	298	my $proto;
	299	sub MODIFY_CODE_ATTRIBUTES { $proto = $_[1]; _: }
ba781e0d	300	eval q{
541ed3a9 FC	301	my $x;
541ed3a9 FC	302	() = sub :a0 { $x };
ba781e0d	303	};
541ed3a9 FC	304	package main;
	305	eval { $proto->() }; # used to crash in pp_entersub
	306	like $@, qr/^Closure prototype called/,
	307	"Calling closure proto with (no) args";
	308	eval { () = &$proto }; # used to crash in pp_leavesub
	309	like $@, qr/^Closure prototype called/,
17e8b60c	310	'Calling closure proto with no @_ that returns a lexical';
541ed3a9 FC	311	}
541ed3a9 FC	312
a1fba7eb FC	313	# [perl #68658] Attributes on stately variables
	314	{
	315	package thwext;
	316	sub MODIFY_SCALAR_ATTRIBUTES { () }
	317	my $i = 0;
	318	my $x_values = '';
	319	eval 'sub foo { use 5.01; state $x :A0 = $i++; $x_values .= $x }';
	320	foo(); foo();
	321	package main;
	322	is $x_values, '00', 'state with attributes';
	323	}
	324
2dc78664	325	done_testing();