1END {print "not ok 1\n" unless $loaded;}
2use v5.6.0;
3use Attribute::Handlers;
4$loaded = 1;
5
6CHECK { $main::phase++ }
7
8######################### End of black magic.
9
10# Insert your test code below (better if it prints "ok 13"
11# (correspondingly "not ok 13") depending on the success of chunk 13
12# of the test code):
13
14sub ok { $::count++; push @::results, [$_[1], $_[0]?"":"not ", defined($_[2])?$_[2]:""]; }
15
16END { print "1..$::count\n";
17      print map "$_->[1]ok $_->[0] $_->[2]\n",
18		sort {$a->[0]<=>$b->[0]}
19			grep $_->[0], @::results }
20
21package Test;
22use warnings;
23no warnings 'redefine';
24
25sub UNIVERSAL::Lastly :ATTR(INIT) { ::ok $_[4][0] && $main::phase, $_[4][1] }
26
27sub UNIVERSAL::Okay :ATTR(BEGIN) {
28::ok $_[4][0] && (!$main::phase || !ref $_[1] && $_[1] eq 'LEXICAL'), $_[4][1];
29}
30
31sub Dokay :ATTR(SCALAR) { ::ok @{$_[4]} }
32sub Dokay :ATTR(HASH)   { ::ok @{$_[4]} }
33sub Dokay :ATTR(ARRAY)  { ::ok @{$_[4]} }
34sub Dokay :ATTR(CODE)   { ::ok @{$_[4]} }
35
36sub Vokay :ATTR(VAR)    { ::ok @{$_[4]} }
37
38sub Aokay :ATTR(ANY)    { ::ok @{$_[4]} }
39
40package main;
41use warnings;
42
43my $x1 :Lastly(1,41);
44my @x1 :Lastly(1=>42);
45my %x1 :Lastly(1,43);
46sub x1 :Lastly(1,44) {}
47
48my Test $x2 :Dokay(1,5);
49
50package Test;
51my $x3 :Dokay(1,6);
52my Test $x4 :Dokay(1,7);
53sub x3 :Dokay(1,8) {}
54
55my $y1 :Okay(1,9);
56my @y1 :Okay(1,10);
57my %y1 :Okay(1,11);
58sub y1 :Okay(1,12) {}
59
60my $y2 :Vokay(1,13);
61my @y2 :Vokay(1,14);
62my %y2 :Vokay(1,15);
63# BEGIN {eval 'sub y2 :Vokay(0,16) {}; 1' or
64::ok(1,16);
65# }
66
67my $z :Aokay(1,17);
68my @z :Aokay(1,18);
69my %z :Aokay(1,19);
70sub z :Aokay(1,20) {};
71
72package DerTest;
73use base 'Test';
74use warnings;
75
76my $x5 :Dokay(1,21);
77my Test $x6 :Dokay(1,22);
78sub x5 :Dokay(1,23);
79
80my $y3 :Okay(1,24);
81my @y3 :Okay(1,25);
82my %y3 :Okay(1,26);
83sub y3 :Okay(1,27) {}
84
85package Unrelated;
86
87my $x11 :Okay(1,1);
88my @x11 :Okay(1=>2);
89my %x11 :Okay(1,3);
90sub x11 :Okay(1,4) {}
91
92BEGIN { eval 'my $x7 :Dokay(0,28)' or ::ok(1,28); }
93my Test $x8 :Dokay(1,29);
94eval 'sub x7 :Dokay(0,30) {}' or ::ok(1,30);
95
96
97package Tie::Loud;
98
99sub TIESCALAR { ::ok(1,31); bless {}, $_[0] }
100sub FETCH { ::ok(1,32); return 1 }
101sub STORE { ::ok(1,33); return 1 }
102
103package Tie::Noisy;
104
105sub TIEARRAY { ::ok(1,$_[1]); bless {}, $_[0] }
106sub FETCH { ::ok(1,35); return 1 }
107sub STORE { ::ok(1,36); return 1 }
108sub FETCHSIZE { 100 }
109
110package Tie::Row::dy;
111
112sub TIEHASH { ::ok(1,$_[1]); bless {}, $_[0] }
113sub FETCH { ::ok(1,38); return 1 }
114sub STORE { ::ok(1,39); return 1 }
115
116package main;
117
118eval 'sub x7 :ATTR(SCALAR) :ATTR(CODE) {}' and ::ok(0,40) or ::ok(1,40);
119
120use Attribute::Handlers autotie => {      Other::Loud => Tie::Loud,
121				                Noisy => Tie::Noisy,
122				     UNIVERSAL::Rowdy => Tie::Row::dy,
123                                   };
124
125my Other $loud : Loud;
126$loud++;
127
128my @noisy : Noisy(34);
129$noisy[0]++;
130
131my %rowdy : Rowdy(37,'this arg should be ignored');
132$rowdy{key}++;
133
134
135# check that applying attributes to lexicals doesn't unduly worry
136# their refcounts
137my $out = "begin\n";
138my $applied;
139sub UNIVERSAL::Dummy :ATTR { ++$applied };
140sub Dummy::DESTROY { $out .= "bye\n" }
141
142{ my $dummy;          $dummy = bless {}, 'Dummy'; }
143ok( $out eq "begin\nbye\n", 45 );
144
145{ my $dummy : Dummy;  $dummy = bless {}, 'Dummy'; }
146if($] < 5.008) {
147ok( 1, 46, " # skip lexicals are not runtime prior to 5.8");
148} else {
149ok( $out eq "begin\nbye\nbye\n", 46);
150}
151# are lexical attributes reapplied correctly?
152sub dummy { my $dummy : Dummy; }
153$applied = 0;
154dummy(); dummy();
155if($] < 5.008) {
156ok(1, 47, " # skip does not work with perl prior to 5.8");
157} else {
158ok( $applied == 2, 47 );
159}
160# 45-47 again, but for our variables
161$out = "begin\n";
162{ our $dummy;          $dummy = bless {}, 'Dummy'; }
163ok( $out eq "begin\n", 48 );
164{ no warnings; our $dummy : Dummy;  $dummy = bless {}, 'Dummy'; }
165ok( $out eq "begin\nbye\n", 49 );
166undef $::dummy;
167ok( $out eq "begin\nbye\nbye\n", 50 );
168
169# are lexical attributes reapplied correctly?
170sub dummy_our { no warnings; our $banjo : Dummy; }
171$applied = 0;
172dummy_our(); dummy_our();
173ok( $applied == 0, 51 );
174
175sub UNIVERSAL::Stooge :ATTR(END) {};
176eval {
177	local $SIG{__WARN__} = sub { die @_ };
178	my $groucho : Stooge;
179};
180my $match = $@ =~ /^Won't be able to apply END handler/;
181if($] < 5.008) {
182ok(1,52 ,"# Skip, no difference between lexical handlers and normal handlers prior to 5.8");
183} else {
184ok( $match, 52 );
185}
186
187
188# The next two check for the phase invariance that Marcel spotted.
189# Subject: Attribute::Handlers phase variance
190# Message-Id: <54EDDB80-FD75-11D6-A18D-00039379E28A@noug.at>
191
192my ($code_applied, $scalar_applied);
193sub Scotty :ATTR(CODE,BEGIN)   { $code_applied = $_[5] }
194{
195no warnings 'redefine';
196sub Scotty :ATTR(SCALAR,CHECK) { $scalar_applied = $_[5] }
197}
198
199sub warp_coil :Scotty {}
200my $photon_torpedo :Scotty;
201
202ok( $code_applied   eq 'BEGIN', 53, "# phase variance" );
203ok( $scalar_applied eq 'CHECK', 54 );
204