Commit | Line | Data |
---|---|---|
a9153838 | 1 | #!/usr/bin/perl -w |
33459055 MS |
2 | |
3 | BEGIN { | |
a9153838 MS |
4 | if( $ENV{PERL_CORE} ) { |
5 | chdir 't'; | |
6 | @INC = ('../lib', 'lib'); | |
7 | } | |
8 | else { | |
9 | unshift @INC, 't/lib'; | |
10 | } | |
33459055 MS |
11 | } |
12 | ||
13 | use strict; | |
33459055 MS |
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 |