Commit | Line | Data |
---|---|---|
09bef843 SB |
1 | #!./perl |
2 | ||
3 | # Regression tests for attrs.pm and the C<sub x : attrs> syntax. | |
4 | ||
5 | BEGIN { | |
6 | chdir 't' if -d 't'; | |
7 | unshift @INC, '../lib'; | |
8 | eval 'require attrs; 1' or do { | |
9 | print "1..0\n"; | |
10 | exit 0; | |
11 | } | |
12 | } | |
13 | ||
14 | sub NTESTS () ; | |
15 | ||
16 | my $test, $ntests; | |
17 | BEGIN {$ntests=0} | |
18 | $test=0; | |
19 | my $failed = 0; | |
20 | ||
21 | print "1..".NTESTS."\n"; | |
22 | ||
23 | eval 'sub t1 ($) { use attrs "locked"; $_[0]++ }'; | |
24 | (print "not "), $failed=1 if $@; | |
25 | print "ok ",++$test,"\n"; | |
26 | BEGIN {++$ntests} | |
27 | ||
28 | eval 'sub t2 { use attrs "locked"; $_[0]++ }'; | |
29 | (print "not "), $failed=1 if $@; | |
30 | print "ok ",++$test,"\n"; | |
31 | BEGIN {++$ntests} | |
32 | ||
33 | eval 'sub t3 ($) : locked ;'; | |
34 | (print "not "), $failed=1 if $@; | |
35 | print "ok ",++$test,"\n"; | |
36 | BEGIN {++$ntests} | |
37 | ||
38 | eval 'sub t4 : locked ;'; | |
39 | (print "not "), $failed=1 if $@; | |
40 | print "ok ",++$test,"\n"; | |
41 | BEGIN {++$ntests} | |
42 | ||
43 | my $anon1; | |
44 | eval '$anon1 = sub ($) { use attrs qw(locked method); $_[0]++ }'; | |
45 | (print "not "), $failed=1 if $@; | |
46 | print "ok ",++$test,"\n"; | |
47 | BEGIN {++$ntests} | |
48 | ||
49 | my $anon2; | |
50 | eval '$anon2 = sub { use attrs qw(locked method); $_[0]++ }'; | |
51 | (print "not "), $failed=1 if $@; | |
52 | print "ok ",++$test,"\n"; | |
53 | BEGIN {++$ntests} | |
54 | ||
55 | my $anon3; | |
56 | eval '$anon3 = sub { use attrs "method"; $_[0]->[1] }'; | |
57 | (print "not "), $failed=1 if $@; | |
58 | print "ok ",++$test,"\n"; | |
59 | BEGIN {++$ntests} | |
60 | ||
61 | my @attrs = attrs::get($anon3 ? $anon3 : \&ns); | |
62 | (print "not "), $failed=1 unless "@attrs" eq "method"; | |
63 | print "ok ",++$test,"\n"; | |
64 | BEGIN {++$ntests} | |
65 | ||
66 | @attrs = sort +attrs::get($anon2 ? $anon2 : \&ns); | |
67 | (print "not "), $failed=1 unless "@attrs" eq "locked method"; | |
68 | print "ok ",++$test,"\n"; | |
69 | BEGIN {++$ntests} | |
70 | ||
71 | @attrs = sort +attrs::get($anon1 ? $anon1 : \&ns); | |
72 | (print "not "), $failed=1 unless "@attrs" eq "locked method"; | |
73 | print "ok ",++$test,"\n"; | |
74 | BEGIN {++$ntests} | |
75 | ||
76 | eval 'sub e1 ($) : plugh ;'; | |
77 | unless ($@ && $@ =~ m/^Invalid CODE attribute: ["']?plugh["']? at/) { | |
78 | my $x = $@; | |
79 | $x =~ s/\n.*\z//s; | |
80 | print "# $x\n"; | |
81 | print "not "; | |
82 | $failed = 1; | |
83 | } | |
84 | print "ok ",++$test,"\n"; | |
85 | BEGIN {++$ntests} | |
86 | ||
87 | eval 'sub e2 ($) : plugh(0,0) xyzzy ;'; | |
88 | unless ($@ && $@ =~ m/^Invalid CODE attributes: ["']?plugh\(0,0\)["']? /) { | |
89 | my $x = $@; | |
90 | $x =~ s/\n.*\z//s; | |
91 | print "# $x\n"; | |
92 | print "not "; | |
93 | $failed = 1; | |
94 | } | |
95 | print "ok ",++$test,"\n"; | |
96 | BEGIN {++$ntests} | |
97 | ||
98 | eval 'sub e3 ($) : plugh(0,0 xyzzy ;'; | |
99 | unless ($@ && $@ =~ m/Unterminated attribute parameter in attribute list at/) { | |
100 | my $x = $@; | |
101 | $x =~ s/\n.*\z//s; | |
102 | print "# $x\n"; | |
103 | print "not "; | |
104 | $failed = 1; | |
105 | } | |
106 | print "ok ",++$test,"\n"; | |
107 | BEGIN {++$ntests} | |
108 | ||
109 | eval 'sub e4 ($) : plugh + xyzzy ;'; | |
110 | unless ($@ && $@ =~ m/Invalid separator character '[+]' in attribute list at/) { | |
111 | my $x = $@; | |
112 | $x =~ s/\n.*\z//s; | |
113 | print "# $x\n"; | |
114 | print "not "; | |
115 | $failed = 1; | |
116 | } | |
117 | print "ok ",++$test,"\n"; | |
118 | BEGIN {++$ntests} | |
119 | ||
120 | ||
121 | # Other tests should be added above this line | |
122 | ||
123 | sub NTESTS () { $ntests } | |
124 | ||
125 | exit $failed; |