10 END {print "not ok 1\n" unless $loaded;}
12 use Attribute::Handlers;
15 CHECK { $main::phase++ }
17 ######################### End of black magic.
19 # Insert your test code below (better if it prints "ok 13"
20 # (correspondingly "not ok 13") depending on the success of chunk 13
23 sub ok { $::count++; push @::results, [$_[1], $_[0]?"":"not ", defined($_[2])?$_[2]:""]; }
25 END { print "1..$::count\n";
26 print map "$_->[1]ok $_->[0] $_->[2]\n",
27 sort {$a->[0]<=>$b->[0]}
28 grep $_->[0], @::results }
32 no warnings 'redefine';
34 sub UNIVERSAL::Lastly :ATTR(INIT) { ::ok $_[4][0] && $main::phase, $_[4][1] }
36 sub UNIVERSAL::Okay :ATTR(BEGIN) {
37 ::ok $_[4][0] && (!$main::phase || !ref $_[1] && $_[1] eq 'LEXICAL'), $_[4][1];
40 sub Dokay :ATTR(SCALAR) { ::ok @{$_[4]} }
41 sub Dokay :ATTR(HASH) { ::ok @{$_[4]} }
42 sub Dokay :ATTR(ARRAY) { ::ok @{$_[4]} }
43 sub Dokay :ATTR(CODE) { ::ok @{$_[4]} }
45 sub Vokay :ATTR(VAR) { ::ok @{$_[4]} }
47 sub Aokay :ATTR(ANY) { ::ok @{$_[4]} }
53 my @x1 :Lastly(1=>42);
55 sub x1 :Lastly(1,44) {}
57 my Test $x2 :Dokay(1,5);
61 my Test $x4 :Dokay(1,7);
72 # BEGIN {eval 'sub y2 :Vokay(0,16) {}; 1' or
79 sub z :Aokay(1,20) {};
86 my Test $x6 :Dokay(1,22);
101 BEGIN { eval 'my $x7 :Dokay(0,28)' or ::ok(1,28); }
102 my Test $x8 :Dokay(1,29);
103 eval 'sub x7 :Dokay(0,30) {}' or ::ok(1,30);
108 sub TIESCALAR { ::ok(1,31); bless {}, $_[0] }
109 sub FETCH { ::ok(1,32); return 1 }
110 sub STORE { ::ok(1,33); return 1 }
114 sub TIEARRAY { ::ok(1,$_[1]); bless {}, $_[0] }
115 sub FETCH { ::ok(1,35); return 1 }
116 sub STORE { ::ok(1,36); return 1 }
117 sub FETCHSIZE { 100 }
119 package Tie::Row::dy;
121 sub TIEHASH { ::ok(1,$_[1]); bless {}, $_[0] }
122 sub FETCH { ::ok(1,38); return 1 }
123 sub STORE { ::ok(1,39); return 1 }
127 eval 'sub x7 :ATTR(SCALAR) :ATTR(CODE) {}' and ::ok(0,40) or ::ok(1,40);
129 use Attribute::Handlers autotie => { Other::Loud => Tie::Loud,
131 UNIVERSAL::Rowdy => Tie::Row::dy,
134 my Other $loud : Loud;
137 my @noisy : Noisy(34);
140 my %rowdy : Rowdy(37,'this arg should be ignored');
144 # check that applying attributes to lexicals doesn't unduly worry
148 sub UNIVERSAL::Dummy :ATTR { ++$applied };
149 sub Dummy::DESTROY { $out .= "bye\n" }
151 { my $dummy; $dummy = bless {}, 'Dummy'; }
152 ok( $out eq "begin\nbye\n", 45 );
154 { my $dummy : Dummy; $dummy = bless {}, 'Dummy'; }
156 ok( 1, 46, " # skip lexicals are not runtime prior to 5.8");
158 ok( $out eq "begin\nbye\nbye\n", 46);
160 # are lexical attributes reapplied correctly?
161 sub dummy { my $dummy : Dummy; }
165 ok(1, 47, " # skip does not work with perl prior to 5.8");
167 ok( $applied == 2, 47 );
169 # 45-47 again, but for our variables
171 { our $dummy; $dummy = bless {}, 'Dummy'; }
172 ok( $out eq "begin\n", 48 );
173 { no warnings; our $dummy : Dummy; $dummy = bless {}, 'Dummy'; }
174 ok( $out eq "begin\nbye\n", 49 );
176 ok( $out eq "begin\nbye\nbye\n", 50 );
178 # are lexical attributes reapplied correctly?
179 sub dummy_our { no warnings; our $banjo : Dummy; }
181 dummy_our(); dummy_our();
182 ok( $applied == 0, 51 );
184 sub UNIVERSAL::Stooge :ATTR(END) {};
186 local $SIG{__WARN__} = sub { die @_ };
187 my $groucho : Stooge;
189 my $match = $@ =~ /^Won't be able to apply END handler/;
191 ok(1,52 ,"# Skip, no difference between lexical handlers and normal handlers prior to 5.8");
197 # The next two check for the phase invariance that Marcel spotted.
198 # Subject: Attribute::Handlers phase variance
199 # Message-Id: <54EDDB80-FD75-11D6-A18D-00039379E28A@noug.at>
201 my ($code_applied, $scalar_applied);
202 sub Scotty :ATTR(CODE,BEGIN) { $code_applied = $_[5] }
204 no warnings 'redefine';
205 sub Scotty :ATTR(SCALAR,CHECK) { $scalar_applied = $_[5] }
208 sub warp_coil :Scotty {}
209 my $photon_torpedo :Scotty;
211 ok( $code_applied eq 'BEGIN', 53, "# phase variance" );
212 ok( $scalar_applied eq 'CHECK', 54 );