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