Fix bug in counting in tempfile().
[p5sagit/p5-mst-13.2.git] / t / op / smartmatch.t
CommitLineData
0d863452 1#!./perl
2
3BEGIN {
4 chdir 't';
5 @INC = '../lib';
6 require './test.pl';
7}
8use strict;
9
10use Tie::Array;
11use 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:
18my $deep1 = []; push @$deep1, \$deep1;
19my $deep2 = []; push @$deep2, \$deep2;
20
21{my $const = "a constant"; sub a_const () {$const}}
22
23my @nums = (1..10);
24tie my @tied_nums, 'Tie::StdArray';
25@tied_nums = (1..10);
26
27my %hash = (foo => 17, bar => 23);
28tie my %tied_hash, 'Tie::StdHash';
29%tied_hash = %hash;
30
31# Load and run the tests
32my @tests = map [chomp and split /\t+/, $_, 3], grep !/^#/ && /\S/, <DATA>;
33plan tests => 2 * @tests;
34
35for my $test (@tests) {
36 my ($yn, $left, $right) = @$test;
37
38 match_test($yn, $left, $right);
39 match_test($yn, $right, $left);
40}
41
42sub 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
59sub foo {}
60sub bar {2}
61sub fatal {die}
62
63sub a_const() {die if @_; "a constant"}
64sub 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, '' }