Commit | Line | Data |
---|---|---|
33459055 MS |
1 | #!perl -w |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | } | |
7 | ||
8 | use strict; | |
9 | use lib qw(../t/lib); | |
10 | ||
11 | use Test::Builder; | |
12 | require Test::Simple::Catch; | |
13 | my($out, $err) = Test::Simple::Catch::caught(); | |
14 | Test::Builder->new->no_header(1); | |
15 | Test::Builder->new->no_ending(1); | |
16 | ||
17 | # Can't use Test.pm, that's a 5.005 thing. | |
18 | package main; | |
19 | ||
20 | print "1..22\n"; | |
21 | ||
22 | my $test_num = 1; | |
23 | # Utility testing functions. | |
24 | sub is ($$;$) { | |
25 | my($this, $that, $name) = @_; | |
26 | my $test = $$this eq $that; | |
27 | my $ok = ''; | |
28 | $ok .= "not " unless $test; | |
29 | $ok .= "ok $test_num"; | |
30 | $ok .= " - $name" if defined $name; | |
31 | $ok .= "\n"; | |
32 | print $ok; | |
33 | ||
34 | unless( $test ) { | |
35 | print "# got \n$$this"; | |
36 | print "# expected \n$that"; | |
37 | } | |
38 | $test_num++; | |
39 | ||
40 | $$this = ''; | |
41 | ||
42 | return $test; | |
43 | } | |
44 | ||
45 | sub like ($$;$) { | |
46 | my($this, $regex, $name) = @_; | |
47 | ||
48 | my $test = $$this =~ /$regex/; | |
49 | ||
50 | my $ok = ''; | |
51 | $ok .= "not " unless $test; | |
52 | $ok .= "ok $test_num"; | |
53 | $ok .= " - $name" if defined $name; | |
54 | $ok .= "\n"; | |
55 | print $ok; | |
56 | ||
57 | unless( $test ) { | |
58 | print "# got \n$$this"; | |
59 | print "# expected \n$regex"; | |
60 | } | |
61 | $test_num++; | |
62 | ||
63 | $$this = ''; | |
64 | ||
65 | ||
66 | return $test; | |
67 | } | |
68 | ||
69 | ||
70 | require Test::More; | |
71 | Test::More->import(tests => 11, import => ['is_deeply']); | |
72 | ||
73 | my $Filename = quotemeta $0; | |
74 | ||
75 | #line 68 | |
76 | is_deeply('foo', 'bar', 'plain strings'); | |
77 | is( $out, "not ok 1 - plain strings\n", 'plain strings' ); | |
78 | is( $err, <<ERR, ' right diagnostic' ); | |
79 | # Failed test ($0 at line 68) | |
80 | # got: 'foo' | |
81 | # expected: 'bar' | |
82 | ERR | |
83 | ||
84 | ||
85 | #line 78 | |
86 | is_deeply({}, [], 'different types'); | |
87 | is( $out, "not ok 2 - different types\n", 'different types' ); | |
88 | like( $err, <<ERR, ' right diagnostic' ); | |
89 | # Failed test \\($Filename at line 78\\) | |
90 | # Structures begin differing at: | |
91 | # \\\$got = 'HASH\\(0x[0-9a-f]+\\)' | |
92 | # \\\$expected = 'ARRAY\\(0x[0-9a-f]+\\)' | |
93 | ERR | |
94 | ||
95 | #line 88 | |
96 | is_deeply({ this => 42 }, { this => 43 }, 'hashes with different values'); | |
97 | is( $out, "not ok 3 - hashes with different values\n", | |
98 | 'hashes with different values' ); | |
99 | is( $err, <<ERR, ' right diagnostic' ); | |
100 | # Failed test ($0 at line 88) | |
101 | # Structures begin differing at: | |
102 | # \$got->{this} = '42' | |
103 | # \$expected->{this} = '43' | |
104 | ERR | |
105 | ||
106 | #line 99 | |
107 | is_deeply({ that => 42 }, { this => 42 }, 'hashes with different keys'); | |
108 | is( $out, "not ok 4 - hashes with different keys\n", | |
109 | 'hashes with different keys' ); | |
110 | is( $err, <<ERR, ' right diagnostic' ); | |
111 | # Failed test ($0 at line 99) | |
112 | # Structures begin differing at: | |
113 | # \$got->{this} = Does not exist | |
114 | # \$expected->{this} = '42' | |
115 | ERR | |
116 | ||
117 | #line 110 | |
118 | is_deeply([1..9], [1..10], 'arrays of different length'); | |
119 | is( $out, "not ok 5 - arrays of different length\n", | |
120 | 'arrays of different length' ); | |
121 | is( $err, <<ERR, ' right diagnostic' ); | |
122 | # Failed test ($0 at line 110) | |
123 | # Structures begin differing at: | |
124 | # \$got->[9] = Does not exist | |
125 | # \$expected->[9] = '10' | |
126 | ERR | |
127 | ||
128 | #line 121 | |
129 | is_deeply([undef, undef], [undef], 'arrays of undefs' ); | |
130 | is( $out, "not ok 6 - arrays of undefs\n", 'arrays of undefs' ); | |
131 | is( $err, <<ERR, ' right diagnostic' ); | |
132 | # Failed test ($0 at line 121) | |
133 | # Structures begin differing at: | |
134 | # \$got->[1] = undef | |
135 | # \$expected->[1] = Does not exist | |
136 | ERR | |
137 | ||
138 | #line 131 | |
139 | is_deeply({ foo => undef }, {}, 'hashes of undefs', 'hashes of undefs' ); | |
140 | is( $out, "not ok 7 - hashes of undefs\n", 'hashes of undefs' ); | |
141 | is( $err, <<ERR, ' right diagnostic' ); | |
142 | # Failed test ($0 at line 131) | |
143 | # Structures begin differing at: | |
144 | # \$got->{foo} = undef | |
145 | # \$expected->{foo} = Does not exist | |
146 | ERR | |
147 | ||
148 | #line 141 | |
149 | is_deeply(\42, \23, 'scalar refs'); | |
150 | is( $out, "not ok 8 - scalar refs\n", 'scalar refs' ); | |
151 | is( $err, <<ERR, ' right diagnostic' ); | |
152 | # Failed test ($0 at line 141) | |
153 | # Structures begin differing at: | |
154 | # \${ \$got} = '42' | |
155 | # \${\$expected} = '23' | |
156 | ERR | |
157 | ||
158 | #line 151 | |
159 | is_deeply([], \23, 'mixed scalar and array refs'); | |
160 | is( $out, "not ok 9 - mixed scalar and array refs\n", | |
161 | 'mixed scalar and array refs' ); | |
162 | like( $err, <<ERR, ' right diagnostic' ); | |
163 | # Failed test \\($Filename at line 151\\) | |
164 | # Structures begin differing at: | |
165 | # \\\$got = 'ARRAY\\(0x[0-9a-f]+\\)' | |
166 | # \\\$expected = 'SCALAR\\(0x[0-9a-f]+\\)' | |
167 | ERR | |
168 | ||
169 | ||
170 | my($a1, $a2, $a3); | |
171 | $a1 = \$a2; $a2 = \$a3; | |
172 | $a3 = 42; | |
173 | ||
174 | my($b1, $b2, $b3); | |
175 | $b1 = \$b2; $b2 = \$b3; | |
176 | $b3 = 23; | |
177 | ||
178 | #line 173 | |
179 | is_deeply($a1, $b1, 'deep scalar refs'); | |
180 | is( $out, "not ok 10 - deep scalar refs\n", 'deep scalar refs' ); | |
181 | is( $err, <<ERR, ' right diagnostic' ); | |
182 | # Failed test ($0 at line 173) | |
183 | # Structures begin differing at: | |
184 | # \${\${ \$got}} = '42' | |
185 | # \${\${\$expected}} = '23' | |
186 | ERR | |
187 | ||
188 | # I don't know how to properly display this structure. | |
189 | # $a2 = { foo => \$a3 }; | |
190 | # $b2 = { foo => \$b3 }; | |
191 | # is_deeply([$a1], [$b1], 'deep mixed scalar refs'); | |
192 | ||
193 | my $foo = { | |
194 | this => [1..10], | |
195 | that => { up => "down", left => "right" }, | |
196 | }; | |
197 | ||
198 | my $bar = { | |
199 | this => [1..10], | |
200 | that => { up => "down", left => "right", foo => 42 }, | |
201 | }; | |
202 | ||
203 | #line 198 | |
204 | is_deeply( $foo, $bar, 'deep structures' ); | |
205 | is( $out, "not ok 11 - deep structures\n", 'deep structures' ); | |
206 | is( $err, <<ERR, ' right diagnostic' ); | |
207 | # Failed test ($0 at line 198) | |
208 | # Structures begin differing at: | |
209 | # \$got->{that}{foo} = Does not exist | |
210 | # \$expected->{that}{foo} = '42' | |
211 | ERR |