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