|
Packit |
dfacfc |
#!./perl -w
|
|
Packit |
dfacfc |
# t/bless.t - Test Bless()
|
|
Packit |
dfacfc |
|
|
Packit |
dfacfc |
BEGIN {
|
|
Packit |
dfacfc |
if ($ENV{PERL_CORE}){
|
|
Packit |
dfacfc |
require Config; import Config;
|
|
Packit |
dfacfc |
no warnings 'once';
|
|
Packit |
dfacfc |
if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
|
|
Packit |
dfacfc |
print "1..0 # Skip: Data::Dumper was not built\n";
|
|
Packit |
dfacfc |
exit 0;
|
|
Packit |
dfacfc |
}
|
|
Packit |
dfacfc |
}
|
|
Packit |
dfacfc |
}
|
|
Packit |
dfacfc |
|
|
Packit |
dfacfc |
use strict;
|
|
Packit |
dfacfc |
|
|
Packit |
dfacfc |
use Data::Dumper;
|
|
Packit |
dfacfc |
use Test::More tests => 8;
|
|
Packit |
dfacfc |
use lib qw( ./t/lib );
|
|
Packit |
dfacfc |
use Testing qw( _dumptostr );
|
|
Packit |
dfacfc |
|
|
Packit |
dfacfc |
my %d = (
|
|
Packit |
dfacfc |
delta => 'd',
|
|
Packit |
dfacfc |
beta => 'b',
|
|
Packit |
dfacfc |
gamma => 'c',
|
|
Packit |
dfacfc |
alpha => 'a',
|
|
Packit |
dfacfc |
);
|
|
Packit |
dfacfc |
|
|
Packit |
dfacfc |
run_tests_for_bless_var_method();
|
|
Packit |
dfacfc |
SKIP: {
|
|
Packit |
dfacfc |
skip "XS version was unavailable, so we already ran with pure Perl", 4
|
|
Packit |
dfacfc |
if $Data::Dumper::Useperl;
|
|
Packit |
dfacfc |
local $Data::Dumper::Useperl = 1;
|
|
Packit |
dfacfc |
run_tests_for_bless_var_method();
|
|
Packit |
dfacfc |
}
|
|
Packit |
dfacfc |
|
|
Packit |
dfacfc |
sub run_tests_for_bless_var_method {
|
|
Packit |
dfacfc |
my ($obj, %dumps, $bless, $starting);
|
|
Packit |
dfacfc |
|
|
Packit |
dfacfc |
note("\$Data::Dumper::Bless and Bless() set to true value");
|
|
Packit |
dfacfc |
|
|
Packit |
dfacfc |
$starting = $Data::Dumper::Bless;
|
|
Packit |
dfacfc |
$bless = 1;
|
|
Packit |
dfacfc |
local $Data::Dumper::Bless = $bless;
|
|
Packit |
dfacfc |
$obj = Data::Dumper->new( [ \%d ] );
|
|
Packit |
dfacfc |
$dumps{'ddblessone'} = _dumptostr($obj);
|
|
Packit |
dfacfc |
local $Data::Dumper::Bless = $starting;
|
|
Packit |
dfacfc |
|
|
Packit |
dfacfc |
$obj = Data::Dumper->new( [ \%d ] );
|
|
Packit |
dfacfc |
$obj->Bless($bless);
|
|
Packit |
dfacfc |
$dumps{'objblessone'} = _dumptostr($obj);
|
|
Packit |
dfacfc |
|
|
Packit |
dfacfc |
is($dumps{'ddblessone'}, $dumps{'objblessone'},
|
|
Packit |
dfacfc |
"\$Data::Dumper::Bless = 1 and Bless(1) are equivalent");
|
|
Packit |
dfacfc |
%dumps = ();
|
|
Packit |
dfacfc |
|
|
Packit |
dfacfc |
$bless = 0;
|
|
Packit |
dfacfc |
local $Data::Dumper::Bless = $bless;
|
|
Packit |
dfacfc |
$obj = Data::Dumper->new( [ \%d ] );
|
|
Packit |
dfacfc |
$dumps{'ddblesszero'} = _dumptostr($obj);
|
|
Packit |
dfacfc |
local $Data::Dumper::Bless = $starting;
|
|
Packit |
dfacfc |
|
|
Packit |
dfacfc |
$obj = Data::Dumper->new( [ \%d ] );
|
|
Packit |
dfacfc |
$obj->Bless($bless);
|
|
Packit |
dfacfc |
$dumps{'objblesszero'} = _dumptostr($obj);
|
|
Packit |
dfacfc |
|
|
Packit |
dfacfc |
is($dumps{'ddblesszero'}, $dumps{'objblesszero'},
|
|
Packit |
dfacfc |
"\$Data::Dumper::Bless = 0 and Bless(0) are equivalent");
|
|
Packit |
dfacfc |
|
|
Packit |
dfacfc |
$bless = undef;
|
|
Packit |
dfacfc |
local $Data::Dumper::Bless = $bless;
|
|
Packit |
dfacfc |
$obj = Data::Dumper->new( [ \%d ] );
|
|
Packit |
dfacfc |
$dumps{'ddblessundef'} = _dumptostr($obj);
|
|
Packit |
dfacfc |
local $Data::Dumper::Bless = $starting;
|
|
Packit |
dfacfc |
|
|
Packit |
dfacfc |
$obj = Data::Dumper->new( [ \%d ] );
|
|
Packit |
dfacfc |
$obj->Bless($bless);
|
|
Packit |
dfacfc |
$dumps{'objblessundef'} = _dumptostr($obj);
|
|
Packit |
dfacfc |
|
|
Packit |
dfacfc |
is($dumps{'ddblessundef'}, $dumps{'objblessundef'},
|
|
Packit |
dfacfc |
"\$Data::Dumper::Bless = undef and Bless(undef) are equivalent");
|
|
Packit |
dfacfc |
is($dumps{'ddblesszero'}, $dumps{'objblessundef'},
|
|
Packit |
dfacfc |
"\$Data::Dumper::Bless = undef and = 0 are equivalent");
|
|
Packit |
dfacfc |
%dumps = ();
|
|
Packit |
dfacfc |
}
|
|
Packit |
dfacfc |
|