This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Retract #20548 and #20465.
[perl5.git] / lib / Test / Simple / t / is_deeply.t
1 #!/usr/bin/perl -w
2
3 BEGIN {
4     if( $ENV{PERL_CORE} ) {
5         chdir 't';
6         @INC = ('../lib', 'lib');
7     }
8     else {
9         unshift @INC, 't/lib';
10     }
11 }
12
13 use strict;
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..28\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