1#!./perl -w
2# t/bless.t - Test Bless()
3
4use strict;
5use warnings;
6
7use Data::Dumper;
8use Test::More tests =>   8;
9use lib qw( ./t/lib );
10use Testing qw( _dumptostr );
11
12my %d = (
13    delta   => 'd',
14    beta    => 'b',
15    gamma   => 'c',
16    alpha   => 'a',
17);
18
19run_tests_for_bless_var_method();
20SKIP: {
21    skip "XS version was unavailable, so we already ran with pure Perl", 4
22        if $Data::Dumper::Useperl;
23    local $Data::Dumper::Useperl = 1;
24    run_tests_for_bless_var_method();
25}
26
27sub run_tests_for_bless_var_method {
28    my ($obj, %dumps, $bless, $starting);
29
30    note("\$Data::Dumper::Bless and Bless() set to true value");
31
32    $starting = $Data::Dumper::Bless;
33    $bless = 1;
34    local $Data::Dumper::Bless = $bless;
35    $obj = Data::Dumper->new( [ \%d ] );
36    $dumps{'ddblessone'} = _dumptostr($obj);
37    local $Data::Dumper::Bless = $starting;
38
39    $obj = Data::Dumper->new( [ \%d ] );
40    $obj->Bless($bless);
41    $dumps{'objblessone'} = _dumptostr($obj);
42
43    is($dumps{'ddblessone'}, $dumps{'objblessone'},
44        "\$Data::Dumper::Bless = 1 and Bless(1) are equivalent");
45    %dumps = ();
46
47    $bless = 0;
48    local $Data::Dumper::Bless = $bless;
49    $obj = Data::Dumper->new( [ \%d ] );
50    $dumps{'ddblesszero'} = _dumptostr($obj);
51    local $Data::Dumper::Bless = $starting;
52
53    $obj = Data::Dumper->new( [ \%d ] );
54    $obj->Bless($bless);
55    $dumps{'objblesszero'} = _dumptostr($obj);
56
57    is($dumps{'ddblesszero'}, $dumps{'objblesszero'},
58        "\$Data::Dumper::Bless = 0 and Bless(0) are equivalent");
59
60    $bless = undef;
61    local $Data::Dumper::Bless = $bless;
62    $obj = Data::Dumper->new( [ \%d ] );
63    $dumps{'ddblessundef'} = _dumptostr($obj);
64    local $Data::Dumper::Bless = $starting;
65
66    $obj = Data::Dumper->new( [ \%d ] );
67    $obj->Bless($bless);
68    $dumps{'objblessundef'} = _dumptostr($obj);
69
70    is($dumps{'ddblessundef'}, $dumps{'objblessundef'},
71        "\$Data::Dumper::Bless = undef and Bless(undef) are equivalent");
72    is($dumps{'ddblesszero'}, $dumps{'objblessundef'},
73        "\$Data::Dumper::Bless = undef and = 0 are equivalent");
74    %dumps = ();
75}
76
77