This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
5056fa833f58e3eda14292fa64012229fd685f3f
[perl5.git] / lib / Attribute / Handlers / test.pl
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}++;