Commit | Line | Data |
dc6b6eef |
1 | # Before `make install' is performed this script should be runnable with |
2 | # `make test'. After `make install' it should work as `perl test.pl' |
3 | |
4 | ######################### We start with some black magic to print on failure. |
5 | |
6 | BEGIN { |
7 | chdir 't' if -d 't'; |
8 | @INC = '../lib'; |
9 | } |
10 | |
11 | # Change 1..1 below to 1..last_test_to_print . |
12 | # (It may become useful if the test is moved to ./t subdirectory.) |
13 | |
14 | END {print "not ok 1\n" unless $loaded;} |
15 | use v5.6.0; |
16 | use Attribute::Handlers; |
17 | $loaded = 1; |
18 | |
19 | ######################### End of black magic. |
20 | |
21 | # Insert your test code below (better if it prints "ok 13" |
22 | # (correspondingly "not ok 13") depending on the success of chunk 13 |
23 | # of the test code): |
24 | |
25 | sub ok { $::count++; push @::results, [$_[1], $_[0]?"":"not "]; } |
26 | |
27 | END { print "1..$::count\n"; |
28 | print map "$_->[1]ok $_->[0]\n", sort {$a->[0]<=>$b->[0]} @::results } |
29 | |
30 | package Test; |
31 | use warnings; |
32 | no warnings 'redefine'; |
33 | |
34 | sub UNIVERSAL::Okay :ATTR { ::ok @{$_[4]} } |
35 | |
36 | sub Dokay :ATTR(SCALAR) { ::ok @{$_[4]} } |
37 | sub Dokay :ATTR(HASH) { ::ok @{$_[4]} } |
38 | sub Dokay :ATTR(ARRAY) { ::ok @{$_[4]} } |
39 | sub Dokay :ATTR(CODE) { ::ok @{$_[4]} } |
40 | |
41 | sub Vokay :ATTR(VAR) { ::ok @{$_[4]} } |
42 | |
43 | sub Aokay :ATTR(ANY) { ::ok @{$_[4]} } |
44 | |
45 | package main; |
46 | use warnings; |
47 | |
48 | my $x1 :Okay(1,1); |
49 | my @x1 :Okay(1=>2); |
50 | my %x1 :Okay(1,3); |
51 | sub x1 :Okay(1,4) {} |
52 | |
53 | my Test $x2 :Dokay(1,5); |
54 | |
55 | package Test; |
56 | my $x3 :Dokay(1,6); |
57 | my Test $x4 :Dokay(1,7); |
58 | sub x3 :Dokay(1,8) {} |
59 | |
60 | my $y1 :Okay(1,9); |
61 | my @y1 :Okay(1,10); |
62 | my %y1 :Okay(1,11); |
63 | sub y1 :Okay(1,12) {} |
64 | |
65 | my $y2 :Vokay(1,13); |
66 | my @y2 :Vokay(1,14); |
67 | my %y2 :Vokay(1,15); |
68 | # BEGIN {eval 'sub y2 :Vokay(0,16) {}; 1' or |
69 | ::ok(1,16); |
70 | # } |
71 | |
72 | my $z :Aokay(1,17); |
73 | my @z :Aokay(1,18); |
74 | my %z :Aokay(1,19); |
75 | sub z :Aokay(1,20) {}; |
76 | |
77 | package DerTest; |
78 | use base 'Test'; |
79 | use warnings; |
80 | |
81 | my $x5 :Dokay(1,21); |
82 | my Test $x6 :Dokay(1,22); |
83 | sub x5 :Dokay(1,23); |
84 | |
85 | my $y3 :Okay(1,24); |
86 | my @y3 :Okay(1,25); |
87 | my %y3 :Okay(1,26); |
88 | sub y3 :Okay(1,27) {} |
89 | |
90 | package Unrelated; |
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::Rowdy; |
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 | use Attribute::Handlers autotie => { Other::Loud => Tie::Loud, |
119 | Noisy => Tie::Noisy, |
120 | UNIVERSAL::Rowdy => Tie::Rowdy, |
121 | }; |
122 | |
123 | my Other $loud : Loud; |
124 | $loud++; |
125 | |
126 | my @noisy : Noisy(34); |
127 | $noisy[0]++; |
128 | |
129 | my %rowdy : Rowdy(37); |
130 | $rowdy{key}++; |