lib/dumpvar.t

   1 #!./perl -- -*- mode: cperl; cperl-indent-level: 4 -*-
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 use strict;
   9
  10 $|=1;
  11
  12 my @prgs;
  13 {
  14     local $/;
  15     @prgs = split "########\n", <DATA>;
  16     close DATA;
  17 }
  18
  19 use Test::More;
  20
  21 plan tests => scalar @prgs;
  22
  23 require "dumpvar.pl";
  24
  25 sub unctrl    { print dumpvar::unctrl($_[0]), "\n" }
  26 sub uniescape { print dumpvar::uniescape($_[0]), "\n" }
  27 sub stringify { print dumpvar::stringify($_[0]), "\n" }
  28 sub dumpvalue {
  29         local $\ = '';
  30         local $, = '';
  31         local $" = ' ';
  32         my @params = @_;
  33         &main::dumpValue(\@params, -1);
  34 }
  35
  36 package Foo;
  37
  38 sub new { my $class = shift; bless [ @_ ], $class }
  39
  40 package Bar;
  41
  42 sub new { my $class = shift; bless [ @_ ], $class }
  43
  44 use overload '""' => sub { "Bar<@{$_[0]}>" };
  45
  46 package main;
  47
  48 my $foo = Foo->new(1..5);
  49 my $bar = Bar->new(1..5);
  50
  51 for (@prgs) {
  52     my($prog, $expected) = split(/\nEXPECT\n?/, $_);
  53     # TODO: dumpvar::stringify() is controlled by a pile of package
  54     # dumpvar variables: $printUndef, $unctrl, $quoteHighBit, $bareStringify,
  55     # and so forth.  We need to test with various settings of those.
  56     my $out = tie *STDOUT, 'TieOut';
  57     eval $prog;
  58     my $ERR = $@;
  59     untie $out;
  60     if ($ERR) {
  61         ok(0, "$prog - $ERR");
  62     } else {
  63         if ($expected =~ m:^/:) {
  64             like($$out, $expected, $prog);
  65         } else {
  66             is($$out, $expected, $prog);
  67         }
  68     }
  69 }
  70
  71 package TieOut;
  72
  73 sub TIEHANDLE {
  74     bless( \(my $self), $_[0] );
  75 }
  76
  77 sub PRINT {
  78     my $self = shift;
  79     $$self .= join('', @_);
  80 }
  81
  82 sub read {
  83     my $self = shift;
  84     substr( $$self, 0, length($$self), '' );
  85 }
  86
  87 __END__
  88 unctrl("A");
  89 EXPECT
  90 A
  91 ########
  92 unctrl("\cA");
  93 EXPECT
  94 ^A
  95 ########
  96 uniescape("A");
  97 EXPECT
  98 A
  99 ########
 100 uniescape("\x{100}");
 101 EXPECT
 102 \x{0100}
 103 ########
 104 stringify(undef);
 105 EXPECT
 106 undef
 107 ########
 108 stringify("foo");
 109 EXPECT
 110 'foo'
 111 ########
 112 stringify("\cA");
 113 EXPECT
 114 "\cA"
 115 ########
 116 stringify(*a);
 117 EXPECT
 118 *main::a
 119 ########
 120 stringify(\undef);
 121 EXPECT
 122 /^'SCALAR\(0x[0-9a-f]+\)'$/i
 123 ########
 124 stringify([]);
 125 EXPECT
 126 /^'ARRAY\(0x[0-9a-f]+\)'$/i
 127 ########
 128 stringify({});
 129 EXPECT
 130 /^'HASH\(0x[0-9a-f]+\)'$/i
 131 ########
 132 stringify(sub{});
 133 EXPECT
 134 /^'CODE\(0x[0-9a-f]+\)'$/i
 135 ########
 136 stringify(\*a);
 137 EXPECT
 138 /^'GLOB\(0x[0-9a-f]+\)'$/i
 139 ########
 140 stringify($foo);
 141 EXPECT
 142 /^'Foo=ARRAY\(0x[0-9a-f]+\)'$/i
 143 ########
 144 stringify($bar);
 145 EXPECT
 146 /^'Bar=ARRAY\(0x[0-9a-f]+\)'$/i
 147 ########
 148 dumpValue(undef);
 149 EXPECT
 150 undef
 151 ########
 152 dumpValue(1);
 153 EXPECT
 154 1
 155 ########
 156 dumpValue("\cA");
 157 EXPECT
 158 "\cA"
 159 ########
 160 dumpValue("\x{100}");
 161 EXPECT
 162 '\x{0100}'
 163 ########
 164 dumpValue("1\n2\n3");
 165 EXPECT
 166 '1
 167 2
 168 3'
 169 ########
 170 dumpValue([1..3],1);
 171 EXPECT
 172 0  1
 173 1  2
 174 2  3
 175 ########
 176 dumpValue({1..4},1);
 177 EXPECT
 178 1 => 2
 179 3 => 4
 180 ########
 181 dumpValue($foo,1);
 182 EXPECT
 183 0  1
 184 1  2
 185 2  3
 186 3  4
 187 4  5
 188 ########
 189 dumpValue($bar,1);
 190 EXPECT
 191 0  1
 192 1  2
 193 2  3
 194 3  4
 195 4  5
 196 ########
 197 dumpvalue("a");
 198 EXPECT
 199 0  'a'
 200 ########
 201 dumpvalue("\cA");
 202 EXPECT
 203 0  "\cA"
 204 ########
 205 dumpvalue("\x{100}");
 206 EXPECT
 207 0  '\x{0100}'
 208 ########
 209 dumpvalue(undef);
 210 EXPECT
 211 0  undef
 212 ########
 213 dumpvalue("foo");
 214 EXPECT
 215 0  'foo'
 216 ########
 217 dumpvalue(\undef);
 218 EXPECT
 219 /0  SCALAR\(0x[0-9a-f]+\)\n   -> undef\n/i
 220 ########
 221 dumpvalue(\\undef);
 222 EXPECT
 223 /0  REF\(0x[0-9a-f]+\)\n   -> SCALAR\(0x[0-9a-f]+\)\n         -> undef\n/i
 224 ########
 225 dumpvalue([]);
 226 EXPECT
 227 /0  ARRAY\(0x[0-9a-f]+\)\n     empty array/i
 228 ########
 229 dumpvalue({});
 230 EXPECT
 231 /0  HASH\(0x[0-9a-f]+\)\n\s+empty hash/i
 232 ########
 233 dumpvalue(sub{});
 234 EXPECT
 235 /0  CODE\(0x[0-9a-f]+\)\n   -> &CODE\(0x[0-9a-f]+\) in /i
 236 ########
 237 dumpvalue(\*a);
 238 EXPECT
 239 /0  GLOB\(0x[0-9a-f]+\)\n   -> \*main::a\n/i
 240 ########
 241 dumpvalue($foo);
 242 EXPECT
 243 /0  Foo=ARRAY\(0x[0-9a-f]+\)\n   0  1\n   1  2\n   2  3\n   3  4\n   4  5\n/i
 244 ########
 245 dumpvalue($bar);
 246 EXPECT
 247 /0  Bar=ARRAY\(0x[0-9a-f]+\)\n   0  1\n   1  2\n   2  3\n   3  4\n   4  5\n/i
 248 ########
 249 dumpvalue("1\n2\n3")
 250 EXPECT
 251 /0  '1\n2\n3'\n/i
 252 ########
 253 dumpvalue([1..4]);
 254 EXPECT
 255 /0  ARRAY\(0x[0-9a-f]+\)\n   0  1\n   1  2\n   2  3\n   3  4\n/i
 256 ########
 257 dumpvalue({1..4});
 258 EXPECT
 259 /0  HASH\(0x[0-9a-f]+\)\n   1 => 2\n   3 => 4\n/i
 260 ########
 261 dumpvalue({1=>2,3=>4});
 262 EXPECT
 263 /0  HASH\(0x[0-9a-f]+\)\n   1 => 2\n   3 => 4\n/i
 264 ########
 265 dumpvalue({a=>1,b=>2});
 266 EXPECT
 267 /0  HASH\(0x[0-9a-f]+\)\n   'a' => 1\n   'b' => 2\n/i
 268 ########
 269 dumpvalue([{a=>[1,2,3],b=>{c=>1,d=>2}},{e=>{f=>1,g=>2},h=>[qw(i j k)]}]);
 270 EXPECT
 271 /0  ARRAY\(0x[0-9a-f]+\)\n   0  HASH\(0x[0-9a-f]+\)\n      'a' => ARRAY\(0x[0-9a-f]+\)\n         0  1\n         1  2\n         2  3\n      'b' => HASH\(0x[0-9a-f]+\)\n         'c' => 1\n         'd' => 2\n   1  HASH\(0x[0-9a-f]+\)\n      'e' => HASH\(0x[0-9a-f]+\)\n         'f' => 1\n         'g' => 2\n      'h' => ARRAY\(0x[0-9a-f]+\)\n         0  'i'\n         1  'j'\n         2  'k'/i
 272 ########
 273 dumpvalue({reverse map {$_=>1} sort qw(the quick brown fox)})
 274 EXPECT
 275 /0  HASH\(0x[0-9a-f]+\)\n   1 => 'brown'\n/i
 276 ########
 277 my @x=qw(a b c); dumpvalue(\@x);
 278 EXPECT
 279 /0  ARRAY\(0x[0-9a-f]+\)\n   0  'a'\n   1  'b'\n   2  'c'\n/i
 280 ########
 281 my %x=(a=>1, b=>2); dumpvalue(\%x);
 282 EXPECT
 283 /0  HASH\(0x[0-9a-f]+\)\n   'a' => 1\n   'b' => 2\n/i