1#!./perl -w 2 3BEGIN { 4 if ($ENV{PERL_CORE}){ 5 require Config; import Config; 6 no warnings 'once'; 7 if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { 8 print "1..0 # Skip: Data::Dumper was not built\n"; 9 exit 0; 10 } 11 } 12} 13 14use strict; 15use Carp; 16use Data::Dumper; 17use Test::More tests => 15; 18use lib qw( ./t/lib ); 19use Testing qw( _dumptostr ); 20 21my ($a, $b, $obj); 22my (@names); 23my (@newnames, $objagain, %newnames); 24my $dumpstr; 25$a = 'alpha'; 26$b = 'beta'; 27 28$obj = Data::Dumper->new([$a,$b], [qw(a b)]); 29@names = $obj->Names; 30is_deeply(\@names, [qw(a b)], "Names() returned expected list"); 31 32@newnames = ( qw| gamma delta | ); 33$objagain = $obj->Names(\@newnames); 34is($objagain, $obj, "Names returned same object"); 35is_deeply($objagain->{names}, \@newnames, 36 "Able to use Names() to set names to be dumped"); 37 38$obj = Data::Dumper->new([$a,$b], [qw(a b)]); 39%newnames = ( gamma => 'delta', epsilon => 'zeta' ); 40eval { @names = $obj->Names(\%newnames); }; 41like($@, qr/Argument to Names, if provided, must be array ref/, 42 "Got expected error message: bad argument to Names()"); 43 44$obj = Data::Dumper->new([$a,$b], [qw(a b)]); 45@newnames = ( qw| gamma delta epsilon | ); 46$objagain = $obj->Names(\@newnames); 47is($objagain, $obj, "Names returned same object"); 48is_deeply($objagain->{names}, \@newnames, 49 "Able to use Names() to set names to be dumped"); 50$dumpstr = _dumptostr($obj); 51like($dumpstr, qr/gamma/s, "Got first name expected"); 52like($dumpstr, qr/delta/s, "Got first name expected"); 53unlike($dumpstr, qr/epsilon/s, "Did not get name which was not expected"); 54 55$obj = Data::Dumper->new([$a,$b], [qw(a b)]); 56@newnames = ( qw| gamma | ); 57$objagain = $obj->Names(\@newnames); 58is($objagain, $obj, "Names returned same object"); 59is_deeply($objagain->{names}, \@newnames, 60 "Able to use Names() to set names to be dumped"); 61$dumpstr = _dumptostr($obj); 62like($dumpstr, qr/gamma/s, "Got name expected"); 63unlike($dumpstr, qr/delta/s, "Did not get name which was not expected"); 64unlike($dumpstr, qr/epsilon/s, "Did not get name which was not expected"); 65like($dumpstr, qr/\$VAR2/s, "Got default name"); 66 67