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; |
51 | { |
52 | use feature "~~"; |
53 | $res = eval $tstr // ""; #/ <- fix syntax colouring |
54 | } |
55 | |
56 | die $@ if $@ ne ""; |
57 | ok( ($yn =~ /!/ xor $res), "$tstr: $res"); |
58 | } |
59 | |
60 | |
61 | |
62 | sub foo {} |
63 | sub bar {2} |
64 | sub fatal {die} |
65 | |
66 | sub a_const() {die if @_; "a constant"} |
67 | sub b_const() {die if @_; "a constant"} |
68 | |
69 | __DATA__ |
70 | # CODE ref against argument |
71 | # - arg is code ref |
72 | \&foo \&foo |
73 | ! \&foo sub {} |
74 | ! \&foo \&bar |
75 | |
76 | # - arg is not code ref |
77 | 1 sub{shift} |
78 | ! 0 sub{shift} |
79 | 1 sub{scalar @_} |
80 | [] \&bar |
81 | {} \&bar |
82 | qr// \&bar |
83 | |
84 | # - null-prototyped subs |
85 | a_const "a constant" |
86 | a_const a_const |
87 | a_const b_const |
88 | |
89 | # HASH ref against: |
90 | # - another hash ref |
91 | {} {} |
92 | ! {} {1 => 2} |
93 | {1 => 2} {1 => 2} |
94 | {1 => 2} {1 => 3} |
95 | ! {1 => 2} {2 => 3} |
96 | \%main:: {map {$_ => 'x'} keys %main::} |
97 | |
98 | # - tied hash ref |
99 | \%hash \%tied_hash |
100 | \%tied_hash \%tied_hash |
101 | |
102 | # - an array ref |
103 | \%:: [keys %main::] |
104 | ! \%:: [] |
105 | {"" => 1} [undef] |
106 | |
107 | # - a regex |
108 | {foo => 1} qr/^(fo[ox])$/ |
109 | ! +{0..100} qr/[13579]$/ |
110 | |
111 | # - a string |
112 | +{foo => 1, bar => 2} "foo" |
113 | ! +{foo => 1, bar => 2} "baz" |
114 | |
115 | |
116 | # ARRAY ref against: |
117 | # - another array ref |
118 | [] [] |
119 | ! [] [1] |
120 | [["foo"], ["bar"]] [qr/o/, qr/a/] |
121 | ["foo", "bar"] [qr/o/, qr/a/] |
122 | $deep1 $deep1 |
123 | ! $deep1 $deep2 |
124 | |
125 | \@nums \@tied_nums |
126 | |
127 | # - a regex |
128 | [qw(foo bar baz quux)] qr/x/ |
129 | ! [qw(foo bar baz quux)] qr/y/ |
130 | |
131 | # - a number |
132 | [qw(1foo 2bar)] 2 |
133 | |
134 | # - a string |
135 | ! [qw(1foo 2bar)] "2" |
136 | |
137 | # Number against number |
138 | 2 2 |
139 | ! 2 3 |
140 | |
141 | # Number against string |
142 | 2 "2" |
143 | 2 "2.0" |
144 | ! 2 "2bananas" |
145 | ! 2_3 "2_3" |
146 | |
147 | # Regex against string |
148 | qr/x/ "x" |
149 | ! qr/y/ "x" |
150 | |
151 | # Regex against number |
152 | 12345 qr/3/ |
153 | |
154 | |
155 | # Test the implicit referencing |
156 | @nums 7 |
157 | @nums \@nums |
158 | ! @nums \\@nums |
159 | @nums [1..10] |
160 | ! @nums [0..9] |
161 | |
162 | %hash "foo" |
163 | %hash /bar/ |