Commit | Line | Data |
0d863452 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't'; |
5 | @INC = '../lib'; |
6 | require './test.pl'; |
7 | } |
8 | use strict; |
9 | |
10 | use Tie::Array; |
11 | use Tie::Hash; |
12 | |
13 | # The feature mechanism is tested in t/lib/feature/smartmatch: |
14 | # This file tests the semantics of the operator, without worrying |
15 | # about feature issues such as scoping etc. |
16 | |
17 | # Predeclare vars used in the tests: |
18 | my $deep1 = []; push @$deep1, \$deep1; |
19 | my $deep2 = []; push @$deep2, \$deep2; |
20 | |
21 | {my $const = "a constant"; sub a_const () {$const}} |
22 | |
23 | my @nums = (1..10); |
24 | tie my @tied_nums, 'Tie::StdArray'; |
25 | @tied_nums = (1..10); |
26 | |
27 | my %hash = (foo => 17, bar => 23); |
28 | tie my %tied_hash, 'Tie::StdHash'; |
29 | %tied_hash = %hash; |
30 | |
31 | # Load and run the tests |
32 | my @tests = map [chomp and split /\t+/, $_, 3], grep !/^#/ && /\S/, <DATA>; |
33 | plan tests => 2 * @tests; |
34 | |
35 | for my $test (@tests) { |
36 | my ($yn, $left, $right) = @$test; |
37 | |
38 | match_test($yn, $left, $right); |
39 | match_test($yn, $right, $left); |
40 | } |
41 | |
42 | sub match_test { |
43 | my ($yn, $left, $right) = @_; |
44 | |
45 | die "Bad test spec: ($yn, $left, $right)" |
46 | unless $yn eq "" || $yn eq "!"; |
47 | |
48 | my $tstr = "$left ~~ $right"; |
49 | |
50 | my $res; |
3e7dd34d |
51 | $res = eval $tstr // ""; #/ <- fix syntax colouring |
0d863452 |
52 | |
53 | die $@ if $@ ne ""; |
54 | ok( ($yn =~ /!/ xor $res), "$tstr: $res"); |
55 | } |
56 | |
57 | |
58 | |
59 | sub foo {} |
60 | sub bar {2} |
61 | sub fatal {die} |
62 | |
63 | sub a_const() {die if @_; "a constant"} |
64 | sub b_const() {die if @_; "a constant"} |
65 | |
66 | __DATA__ |
67 | # CODE ref against argument |
68 | # - arg is code ref |
69 | \&foo \&foo |
70 | ! \&foo sub {} |
71 | ! \&foo \&bar |
72 | |
73 | # - arg is not code ref |
74 | 1 sub{shift} |
75 | ! 0 sub{shift} |
76 | 1 sub{scalar @_} |
77 | [] \&bar |
78 | {} \&bar |
79 | qr// \&bar |
80 | |
81 | # - null-prototyped subs |
82 | a_const "a constant" |
83 | a_const a_const |
84 | a_const b_const |
85 | |
86 | # HASH ref against: |
87 | # - another hash ref |
88 | {} {} |
89 | ! {} {1 => 2} |
90 | {1 => 2} {1 => 2} |
91 | {1 => 2} {1 => 3} |
92 | ! {1 => 2} {2 => 3} |
93 | \%main:: {map {$_ => 'x'} keys %main::} |
94 | |
95 | # - tied hash ref |
96 | \%hash \%tied_hash |
97 | \%tied_hash \%tied_hash |
98 | |
99 | # - an array ref |
100 | \%:: [keys %main::] |
101 | ! \%:: [] |
102 | {"" => 1} [undef] |
71b0fb34 |
103 | { foo => 1 } ["foo"] |
104 | { foo => 1 } ["foo", "bar"] |
105 | \%hash ["foo", "bar"] |
106 | \%hash ["foo"] |
107 | ! \%hash ["quux"] |
108 | \%hash [qw(foo quux)] |
0d863452 |
109 | |
110 | # - a regex |
111 | {foo => 1} qr/^(fo[ox])$/ |
112 | ! +{0..100} qr/[13579]$/ |
113 | |
114 | # - a string |
115 | +{foo => 1, bar => 2} "foo" |
116 | ! +{foo => 1, bar => 2} "baz" |
117 | |
118 | |
119 | # ARRAY ref against: |
120 | # - another array ref |
121 | [] [] |
122 | ! [] [1] |
123 | [["foo"], ["bar"]] [qr/o/, qr/a/] |
124 | ["foo", "bar"] [qr/o/, qr/a/] |
71b0fb34 |
125 | ! ["foo", "bar"] [qr/o/, "foo"] |
0d863452 |
126 | $deep1 $deep1 |
127 | ! $deep1 $deep2 |
128 | |
129 | \@nums \@tied_nums |
130 | |
131 | # - a regex |
132 | [qw(foo bar baz quux)] qr/x/ |
133 | ! [qw(foo bar baz quux)] qr/y/ |
134 | |
135 | # - a number |
136 | [qw(1foo 2bar)] 2 |
137 | |
138 | # - a string |
139 | ! [qw(1foo 2bar)] "2" |
140 | |
141 | # Number against number |
142 | 2 2 |
143 | ! 2 3 |
144 | |
145 | # Number against string |
146 | 2 "2" |
147 | 2 "2.0" |
148 | ! 2 "2bananas" |
149 | ! 2_3 "2_3" |
150 | |
151 | # Regex against string |
152 | qr/x/ "x" |
153 | ! qr/y/ "x" |
154 | |
155 | # Regex against number |
156 | 12345 qr/3/ |
157 | |
158 | |
159 | # Test the implicit referencing |
160 | @nums 7 |
161 | @nums \@nums |
162 | ! @nums \\@nums |
163 | @nums [1..10] |
164 | ! @nums [0..9] |
165 | |
166 | %hash "foo" |
167 | %hash /bar/ |
71b0fb34 |
168 | %hash [qw(bar)] |
169 | ! %hash [qw(a b c)] |
170 | %hash %hash |
171 | %hash {%hash} |
172 | %hash %tied_hash |
173 | %tied_hash %tied_hash |
174 | %hash { foo => 5, bar => 10 } |
175 | ! %hash { foo => 5, bar => 10, quux => 15 } |
176 | |
177 | @nums { 1, '', 2, '' } |
178 | @nums { 1, '', 12, '' } |
179 | ! @nums { 11, '', 12, '' } |