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