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