Commit | Line | Data |
0e9b9e0c |
1 | END {print "not ok 1\n" unless $loaded;} |
2 | use v5.6.0; |
3 | use Attribute::Handlers; |
4 | $loaded = 1; |
5 | |
6 | CHECK { $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 | |
14 | sub ok { $::count++; push @::results, [$_[1], $_[0]?"":"not "]; } |
15 | |
16 | END { print "1..$::count\n"; |
17 | print map "$_->[1]ok $_->[0]\n", |
18 | sort {$a->[0]<=>$b->[0]} |
19 | grep $_->[0], @::results } |
20 | |
21 | package Test; |
22 | use warnings; |
23 | no warnings 'redefine'; |
24 | |
25 | sub UNIVERSAL::Lastly :ATTR(INIT) { ::ok $_[4][0] && $main::phase, $_[4][1] } |
26 | |
27 | sub UNIVERSAL::Okay :ATTR(BEGIN) { |
28 | ::ok $_[4][0] && (!$main::phase || !ref $_[1] && $_[1] eq 'LEXICAL'), $_[4][1]; |
29 | } |
30 | |
31 | sub Dokay :ATTR(SCALAR) { ::ok @{$_[4]} } |
32 | sub Dokay :ATTR(HASH) { ::ok @{$_[4]} } |
33 | sub Dokay :ATTR(ARRAY) { ::ok @{$_[4]} } |
34 | sub Dokay :ATTR(CODE) { ::ok @{$_[4]} } |
35 | |
36 | sub Vokay :ATTR(VAR) { ::ok @{$_[4]} } |
37 | |
38 | sub Aokay :ATTR(ANY) { ::ok @{$_[4]} } |
39 | |
40 | package main; |
41 | use warnings; |
42 | |
43 | my $x1 :Lastly(1,41); |
44 | my @x1 :Lastly(1=>42); |
45 | my %x1 :Lastly(1,43); |
46 | sub x1 :Lastly(1,44) {} |
47 | |
48 | my Test $x2 :Dokay(1,5); |
49 | |
50 | package Test; |
51 | my $x3 :Dokay(1,6); |
52 | my Test $x4 :Dokay(1,7); |
53 | sub x3 :Dokay(1,8) {} |
54 | |
55 | my $y1 :Okay(1,9); |
56 | my @y1 :Okay(1,10); |
57 | my %y1 :Okay(1,11); |
58 | sub y1 :Okay(1,12) {} |
59 | |
60 | my $y2 :Vokay(1,13); |
61 | my @y2 :Vokay(1,14); |
62 | my %y2 :Vokay(1,15); |
63 | # BEGIN {eval 'sub y2 :Vokay(0,16) {}; 1' or |
64 | ::ok(1,16); |
65 | # } |
66 | |
67 | my $z :Aokay(1,17); |
68 | my @z :Aokay(1,18); |
69 | my %z :Aokay(1,19); |
70 | sub z :Aokay(1,20) {}; |
71 | |
72 | package DerTest; |
73 | use base 'Test'; |
74 | use warnings; |
75 | |
76 | my $x5 :Dokay(1,21); |
77 | my Test $x6 :Dokay(1,22); |
78 | sub x5 :Dokay(1,23); |
79 | |
80 | my $y3 :Okay(1,24); |
81 | my @y3 :Okay(1,25); |
82 | my %y3 :Okay(1,26); |
83 | sub y3 :Okay(1,27) {} |
84 | |
85 | package Unrelated; |
86 | |
87 | my $x11 :Okay(1,1); |
88 | my @x11 :Okay(1=>2); |
89 | my %x11 :Okay(1,3); |
90 | sub x11 :Okay(1,4) {} |
91 | |
92 | BEGIN { eval 'my $x7 :Dokay(0,28)' or ::ok(1,28); } |
93 | my Test $x8 :Dokay(1,29); |
94 | eval 'sub x7 :Dokay(0,30) {}' or ::ok(1,30); |
95 | |
96 | |
97 | package Tie::Loud; |
98 | |
99 | sub TIESCALAR { ::ok(1,31); bless {}, $_[0] } |
100 | sub FETCH { ::ok(1,32); return 1 } |
101 | sub STORE { ::ok(1,33); return 1 } |
102 | |
103 | package Tie::Noisy; |
104 | |
105 | sub TIEARRAY { ::ok(1,$_[1]); bless {}, $_[0] } |
106 | sub FETCH { ::ok(1,35); return 1 } |
107 | sub STORE { ::ok(1,36); return 1 } |
108 | sub FETCHSIZE { 100 } |
109 | |
110 | package Tie::Row::dy; |
111 | |
112 | sub TIEHASH { ::ok(1,$_[1]); bless {}, $_[0] } |
113 | sub FETCH { ::ok(1,38); return 1 } |
114 | sub STORE { ::ok(1,39); return 1 } |
115 | |
116 | package main; |
117 | |
118 | eval 'sub x7 :ATTR(SCALAR) :ATTR(CODE) {}' and ::ok(0,40) or ::ok(1,40); |
119 | |
120 | use Attribute::Handlers autotie => { Other::Loud => Tie::Loud, |
121 | Noisy => Tie::Noisy, |
122 | UNIVERSAL::Rowdy => Tie::Row::dy, |
123 | }; |
124 | |
125 | my Other $loud : Loud; |
126 | $loud++; |
127 | |
128 | my @noisy : Noisy(34); |
129 | $noisy[0]++; |
130 | |
131 | my %rowdy : Rowdy(37,'this arg should be ignored'); |
132 | $rowdy{key}++; |
133 | |
235bddc8 |
134 | |
135 | # check that applying attributes to lexicals doesn't unduly worry |
136 | # their refcounts |
137 | my $out = "begin\n"; |
138 | my $applied; |
139 | sub UNIVERSAL::Dummy :ATTR { ++$applied }; |
140 | sub Dummy::DESTROY { $out .= "bye\n" } |
141 | |
142 | { my $dummy; $dummy = bless {}, 'Dummy'; } |
143 | ok( $out eq "begin\nbye\n", 45 ); |
144 | |
145 | { my $dummy : Dummy; $dummy = bless {}, 'Dummy'; } |
146 | ok( $out eq "begin\nbye\nbye\n", 46 ); |
147 | |
148 | # are lexical attributes reapplied correctly? |
149 | sub dummy { my $dummy : Dummy; } |
150 | $applied = 0; |
151 | dummy(); dummy(); |
152 | ok( $applied == 2, 47 ); |
153 | |
154 | # 45-47 again, but for our variables |
155 | $out = "begin\n"; |
156 | { our $dummy; $dummy = bless {}, 'Dummy'; } |
157 | ok( $out eq "begin\n", 48 ); |
158 | { our $dummy : Dummy; $dummy = bless {}, 'Dummy'; } |
159 | ok( $out eq "begin\nbye\n", 49 ); |
160 | undef $::dummy; |
161 | ok( $out eq "begin\nbye\nbye\n", 50 ); |
162 | |
163 | # are lexical attributes reapplied correctly? |
164 | sub dummy_our { our $banjo : Dummy; } |
165 | $applied = 0; |
166 | dummy_our(); dummy_our(); |
167 | ok( $applied == 0, 51 ); |