File: base.t

package info (click to toggle)
libdata-visitor-perl 0.30-2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid, stretch
  • size: 204 kB
  • ctags: 49
  • sloc: perl: 1,169; makefile: 2
file content (100 lines) | stat: -rw-r--r-- 2,355 bytes parent folder | download | duplicates (3)
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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
#!/usr/bin/perl

use strict;
use warnings;

use Test::More;

use Data::Visitor;

can_ok('Data::Visitor', "new");
isa_ok(my $o = Data::Visitor->new, 'Data::Visitor');

can_ok( $o, "visit" );

my @things = ( "foo", 1, undef, 0, {}, [], do { my $x = "blah"; \$x }, bless({}, "Some::Class") );

$o->visit($_) for @things; # no explosions in void context

is_deeply( $o->visit( $_ ), $_, "visit returns value unlatered" ) for @things;

can_ok( $o, "visit_value" );
can_ok( $o, "visit_object" );
can_ok( $o, "visit_hash" );
can_ok( $o, "visit_array" );


my $mock;
my %called;

{
    my $meta = Class::MOP::class_of($o);

    my $class;
    $class = $meta->create_anon_class(
        superclasses => [$meta->name],
        methods      => {
            meta => sub { $class },
            map {
                my $e = $_;
                ($e->[0] => sub { $called{ $e->[0] }++; $e->[1]->(@_) })
            } (
                [ visit_value    => sub { 'magic' } ],
                [ visit_object   => sub { 'magic' } ],
                [ visit_hash_key => sub { $_[1] } ],
                [ visit_hash     => sub { shift->Data::Visitor::visit_hash(@_) } ],
                [ visit_array    => sub { shift->Data::Visitor::visit_array(@_) } ],
            )
        },
    );

    $mock = $class->rebless_instance($o);
}


# cause logging
%called = ();
$mock->visit( "foo" );
ok($called{visit_value});

%called = ();
$mock->visit( 1 );
ok($called{visit_value});

%called = ();
$mock->visit( undef );
ok($called{visit_value});

%called = ();
$mock->visit( [ ] );
ok($called{visit_array});
ok(!$called{visit_value}, "visit_value not called");

%called = ();
$mock->visit( [ "foo" ] );
ok($called{visit_array});
ok($called{visit_value});

%called = ();
$mock->visit( "foo" );
ok($called{visit_value});

%called = ();
$mock->visit( {} );
ok($called{visit_hash});
ok(!$called{visit_value}, "visit_value not called");

%called = ();
$mock->visit( { foo => "bar" } );
ok($called{visit_hash});
ok($called{visit_value});

%called = ();
$mock->visit( bless {}, "Foo" );
ok($called{visit_object});

is_deeply( $mock->visit( undef ), "magic", "fmap behavior on value" );
is_deeply( $mock->visit( { foo => "bar" } ), { foo => "magic" }, "fmap behavior on hash" );
is_deeply( $mock->visit( [qw/la di da/]), [qw/magic magic magic/], "fmap behavior on array" );

done_testing;