1#!/usr/bin/perl -w 2 3BEGIN { 4 if( $ENV{PERL_CORE} ) { 5 chdir 't'; 6 @INC = ('../lib', 'lib'); 7 } 8 else { 9 unshift @INC, 't/lib'; 10 } 11} 12 13use strict; 14 15use Test::Builder; 16require Test::Simple::Catch; 17my($out, $err) = Test::Simple::Catch::caught(); 18Test::Builder->new->no_header(1); 19Test::Builder->new->no_ending(1); 20 21# Can't use Test.pm, that's a 5.005 thing. 22package main; 23 24print "1..22\n"; 25 26my $test_num = 1; 27# Utility testing functions. 28sub 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 49sub 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 74require Test::More; 75Test::More->import(tests => 11, import => ['is_deeply']); 76 77my $Filename = quotemeta $0; 78 79#line 68 80is_deeply('foo', 'bar', 'plain strings'); 81is( $out, "not ok 1 - plain strings\n", 'plain strings' ); 82is( $err, <<ERR, ' right diagnostic' ); 83# Failed test ($0 at line 68) 84# got: 'foo' 85# expected: 'bar' 86ERR 87 88 89#line 78 90is_deeply({}, [], 'different types'); 91is( $out, "not ok 2 - different types\n", 'different types' ); 92like( $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]+\\)' 97ERR 98 99#line 88 100is_deeply({ this => 42 }, { this => 43 }, 'hashes with different values'); 101is( $out, "not ok 3 - hashes with different values\n", 102 'hashes with different values' ); 103is( $err, <<ERR, ' right diagnostic' ); 104# Failed test ($0 at line 88) 105# Structures begin differing at: 106# \$got->{this} = '42' 107# \$expected->{this} = '43' 108ERR 109 110#line 99 111is_deeply({ that => 42 }, { this => 42 }, 'hashes with different keys'); 112is( $out, "not ok 4 - hashes with different keys\n", 113 'hashes with different keys' ); 114is( $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' 119ERR 120 121#line 110 122is_deeply([1..9], [1..10], 'arrays of different length'); 123is( $out, "not ok 5 - arrays of different length\n", 124 'arrays of different length' ); 125is( $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' 130ERR 131 132#line 121 133is_deeply([undef, undef], [undef], 'arrays of undefs' ); 134is( $out, "not ok 6 - arrays of undefs\n", 'arrays of undefs' ); 135is( $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 140ERR 141 142#line 131 143is_deeply({ foo => undef }, {}, 'hashes of undefs', 'hashes of undefs' ); 144is( $out, "not ok 7 - hashes of undefs\n", 'hashes of undefs' ); 145is( $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 150ERR 151 152#line 141 153is_deeply(\42, \23, 'scalar refs'); 154is( $out, "not ok 8 - scalar refs\n", 'scalar refs' ); 155is( $err, <<ERR, ' right diagnostic' ); 156# Failed test ($0 at line 141) 157# Structures begin differing at: 158# \${ \$got} = '42' 159# \${\$expected} = '23' 160ERR 161 162#line 151 163is_deeply([], \23, 'mixed scalar and array refs'); 164is( $out, "not ok 9 - mixed scalar and array refs\n", 165 'mixed scalar and array refs' ); 166like( $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]+\\)' 171ERR 172 173 174my($a1, $a2, $a3); 175$a1 = \$a2; $a2 = \$a3; 176$a3 = 42; 177 178my($b1, $b2, $b3); 179$b1 = \$b2; $b2 = \$b3; 180$b3 = 23; 181 182#line 173 183is_deeply($a1, $b1, 'deep scalar refs'); 184is( $out, "not ok 10 - deep scalar refs\n", 'deep scalar refs' ); 185is( $err, <<ERR, ' right diagnostic' ); 186# Failed test ($0 at line 173) 187# Structures begin differing at: 188# \${\${ \$got}} = '42' 189# \${\${\$expected}} = '23' 190ERR 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 197my $foo = { 198 this => [1..10], 199 that => { up => "down", left => "right" }, 200 }; 201 202my $bar = { 203 this => [1..10], 204 that => { up => "down", left => "right", foo => 42 }, 205 }; 206 207#line 198 208is_deeply( $foo, $bar, 'deep structures' ); 209is( $out, "not ok 11 - deep structures\n", 'deep structures' ); 210is( $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' 215ERR 216