1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
#!perl -w
use strict;
use Test qw(plan ok);
plan tests => 41;
use Data::Dump qw(dumpf);
ok(dumpf("foo", sub { return { dump => "x" }}), 'x');
ok(dumpf("foo", sub { return { object => "x" }}), '"x"');
ok(dumpf("foo", sub { return { comment => "x" }}), "# x\n\"foo\"");
ok(dumpf({}, sub { return { bless => "x"}}), "bless({}, \"x\")");
ok(dumpf({a => 1, b => 2}, sub { return { hide_keys => ["b"] }}), "{ a => 1 }");
ok(dumpf("foo", sub { return }), '"foo"');
my $cb_count = 0;
ok(dumpf("foo", sub {
my($ctx, $obj) = @_;
$cb_count++;
ok($$obj, "foo");
ok($ctx->object_ref, $obj);
ok($ctx->class, "");
ok(!$ctx->object_isa("SCALAR"));
ok($ctx->container_class, "");
ok(!$ctx->container_isa("SCALAR"));
ok($ctx->container_self, "");
ok(!$ctx->is_ref);
ok(!$ctx->is_blessed);
ok(!$ctx->is_array);
ok(!$ctx->is_hash);
ok( $ctx->is_scalar);
ok(!$ctx->is_code);
ok($ctx->depth, 0);
return;
}), '"foo"');
ok($cb_count, 1);
$cb_count = 0;
ok(dumpf(bless({ a => 1, b => bless {}, "Bar"}, "Foo"), sub {
my($ctx, $obj) = @_;
$cb_count++;
return unless $ctx->object_isa("Bar");
ok(ref($obj), "Bar");
ok($ctx->object_ref, $obj);
ok($ctx->class, "Bar");
ok($ctx->object_isa("Bar"));
ok(!$ctx->object_isa("Foo"));
ok($ctx->container_class, "Foo");
ok($ctx->container_isa("Foo"));
ok($ctx->container_self, '$self->{b}');
ok($ctx->is_ref);
ok($ctx->is_blessed);
ok(!$ctx->is_array);
ok($ctx->is_hash);
ok(!$ctx->is_scalar);
ok(!$ctx->is_code);
ok($ctx->depth, 1);
ok($ctx->expr, '$var->{b}');
ok($ctx->expr("ref"), '$ref->{b}');
return;
}) =~ /^bless\(.*, "Foo"\)\z/);
ok($cb_count, 3);
|
