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..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