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