1#!./perl -w 2# t/misc.t - Test various functionality 3 4use strict; 5use warnings; 6 7use Data::Dumper; 8use Test::More tests => 18; 9use lib qw( ./t/lib ); 10use Testing qw( _dumptostr ); 11 12my ($a, $b, @c, %d); 13$a = 'alpha'; 14$b = 'beta'; 15@c = ( qw| gamma delta epsilon | ); 16%d = ( zeta => 'eta', theta => 'iota' ); 17 18note("Argument validation for new()"); 19{ 20 local $@ = ''; 21 eval { my $obj = Data::Dumper->new(undef); }; 22 like($@, 23 qr/^Usage:\s+PACKAGE->new\(ARRAYREF,\s*\[ARRAYREF\]\)/, 24 "Got error message: new() needs defined argument" 25 ); 26} 27 28{ 29 local $@ = ''; 30 eval { my $obj = Data::Dumper->new( { $a => $b } ); }; 31 like($@, 32 qr/^Usage:\s+PACKAGE->new\(ARRAYREF,\s*\[ARRAYREF\]\)/, 33 "Got error message: new() needs array reference" 34 ); 35} 36 37{ 38 note("\$Data::Dumper::Useperl, Useqq, Deparse"); 39 my ($obj, %dumpstr); 40 41 local $Data::Dumper::Useperl = 1; 42 $obj = Data::Dumper->new( [ \@c, \%d ] ); 43 $dumpstr{useperl} = [ $obj->Values ]; 44 local $Data::Dumper::Useperl = 0; 45 46 local $Data::Dumper::Useqq = 1; 47 $obj = Data::Dumper->new( [ \@c, \%d ] ); 48 $dumpstr{useqq} = [ $obj->Values ]; 49 local $Data::Dumper::Useqq = 0; 50 51 is_deeply($dumpstr{useperl}, $dumpstr{useqq}, 52 "Useperl and Useqq return same"); 53 54 local $Data::Dumper::Deparse = 1; 55 $obj = Data::Dumper->new( [ \@c, \%d ] ); 56 $dumpstr{deparse} = [ $obj->Values ]; 57 local $Data::Dumper::Deparse = 0; 58 59 is_deeply($dumpstr{useperl}, $dumpstr{deparse}, 60 "Useperl and Deparse return same"); 61} 62 63{ 64 note("\$Data::Dumper::Pad and \$obj->Pad"); 65 my ($obj, %dumps, $pad); 66 $obj = Data::Dumper->new([$a,$b]); 67 $dumps{'noprev'} = _dumptostr($obj); 68 69 $obj = Data::Dumper->new([$a,$b]); 70 $obj->Pad(''); 71 $dumps{'emptystring'} = _dumptostr($obj); 72 73 is($dumps{'noprev'}, $dumps{'emptystring'}, 74 "No setting for \$Data::Dumper::Pad and Pad('') give same result"); 75 76 $pad = 'XXX: '; 77 local $Data::Dumper::Pad = $pad; 78 $obj = Data::Dumper->new([$a,$b]); 79 $dumps{'ddp'} = _dumptostr($obj); 80 local $Data::Dumper::Pad = ''; 81 82 $obj = Data::Dumper->new([$a,$b]); 83 $obj->Pad($pad); 84 $dumps{'obj'} = _dumptostr($obj); 85 86 is($dumps{'ddp'}, $dumps{'obj'}, 87 "\$Data::Dumper::Pad and \$obj->Pad() give same result"); 88 89 is( (grep {! /^$pad/} (split(/\n/, $dumps{'ddp'}))), 0, 90 "Each line of dumped output padded as expected"); 91} 92 93{ 94 note("\$Data::Dumper::Varname and \$obj->Varname"); 95 my ($obj, %dumps, $varname); 96 $obj = Data::Dumper->new([$a,$b]); 97 $dumps{'noprev'} = _dumptostr($obj); 98 99 $obj = Data::Dumper->new([$a,$b]); 100 $obj->Varname(''); 101 $dumps{'emptystring'} = _dumptostr($obj); 102 103 # Because Varname defaults to '$VAR', providing an empty argument to 104 # Varname produces a non-default result. 105 isnt($dumps{'noprev'}, $dumps{'emptystring'}, 106 "No setting for \$Data::Dumper::Varname and Varname('') give different results"); 107 108 $varname = 'MIMI'; 109 local $Data::Dumper::Varname = $varname; 110 $obj = Data::Dumper->new([$a,$b]); 111 $dumps{'ddv'} = _dumptostr($obj); 112 local $Data::Dumper::Varname = undef; 113 114 $obj = Data::Dumper->new([$a,$b]); 115 $obj->Varname($varname); 116 $dumps{'varname'} = _dumptostr($obj); 117 118 is($dumps{'ddv'}, $dumps{'varname'}, 119 "Setting for \$Data::Dumper::Varname and Varname() give same result"); 120 121 is( (grep { /^\$$varname/ } (split(/\n/, $dumps{'ddv'}))), 2, 122 "All lines of dumped output use provided varname"); 123 124 is( (grep { /^\$VAR/ } (split(/\n/, $dumps{'ddv'}))), 0, 125 "No lines of dumped output use default \$VAR"); 126} 127 128{ 129 note("\$Data::Dumper::Useqq and \$obj->Useqq"); 130 my ($obj, %dumps, $useqq); 131 $obj = Data::Dumper->new([$a,$b]); 132 $dumps{'noprev'} = _dumptostr($obj); 133 134 $obj = Data::Dumper->new([$a,$b]); 135 $obj->Useqq(undef); 136 $dumps{'undef'} = _dumptostr($obj); 137 138 $obj = Data::Dumper->new([$a,$b]); 139 $obj->Useqq(''); 140 $dumps{'emptystring'} = _dumptostr($obj); 141 142 $obj = Data::Dumper->new([$a,$b]); 143 $obj->Useqq(0); 144 $dumps{'zero'} = _dumptostr($obj); 145 146 my $current = $Data::Dumper::Useqq; 147 local $Data::Dumper::Useqq = 0; 148 $obj = Data::Dumper->new([$a,$b]); 149 $dumps{'dduzero'} = _dumptostr($obj); 150 local $Data::Dumper::Useqq = $current; 151 152 is($dumps{'noprev'}, $dumps{'undef'}, 153 "No setting for \$Data::Dumper::Useqq and Useqq(undef) give same result"); 154 155 is($dumps{'noprev'}, $dumps{'zero'}, 156 "No setting for \$Data::Dumper::Useqq and Useqq(0) give same result"); 157 158 is($dumps{'noprev'}, $dumps{'emptystring'}, 159 "No setting for \$Data::Dumper::Useqq and Useqq('') give same result"); 160 161 is($dumps{'noprev'}, $dumps{'dduzero'}, 162 "No setting for \$Data::Dumper::Useqq and Useqq(undef) give same result"); 163 164 local $Data::Dumper::Useqq = 1; 165 $obj = Data::Dumper->new([$a,$b]); 166 $dumps{'ddu'} = _dumptostr($obj); 167 local $Data::Dumper::Useqq = $current; 168 169 $obj = Data::Dumper->new([$a,$b]); 170 $obj->Useqq(1); 171 $dumps{'obj'} = _dumptostr($obj); 172 173 is($dumps{'ddu'}, $dumps{'obj'}, 174 "\$Data::Dumper::Useqq=1 and Useqq(1) give same result"); 175 176 like($dumps{'ddu'}, 177 qr/"$a".+?"$b"/s, 178 "Double-quotes used around values" 179 ); 180 181 unlike($dumps{'ddu'}, 182 qr/'$a'.+?'$b'/s, 183 "Single-quotes not used around values" 184 ); 185} 186