Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Re: Data::XDumper

by demerphq (Chancellor)
on Feb 17, 2003 at 15:50 UTC ( #235990=note: print w/replies, xml ) Need Help??


in reply to Data::XDumper

Here a set of of test cases that I developer for a serialization comparison test suite that I wrote (unpublished). To understand it and convert it to your own uses all you need to remember is that serializer_ok takes the following parameters:
serializer_ok($dumper_object, $object_to_dump, $test_name) $dumper_obj is a wrapper around various dumper implementations. $object_to_dump is a single value to dump (multiples can be wrapped in an array). Incidentally this routine does a low level comparison of the results of the serialization, as well as a twice in a row test. (Ie is $a->dumped->evaled->dumped == $a)
and that Data::Tools->capture() is functionally equivelent to the following sub

sub capture { \@_ }

Incidentally I welcome correspondance about your dumper and testing it. When I get a chance to review your code I will add it to my serialization tests (provided that this is possible, as I said I havent reviewed XDumper yet.)

{ my $cyclic_array=[]; $cyclic_array->[0]=\$cyclic_array->[1]; $cyclic_array->[1]=\$cyclic_array->[0]; my ($cyclic_scalar1,$cyclic_scalar2); ($cyclic_scalar1,$cyclic_scalar2)=(\$cyclic_scalar2,\$cyclic_scala +r1); my $cyclic_scalar_array=[($cyclic_scalar1,$cyclic_scalar2)]; serializer_ok($obj,$cyclic_array, "Array Scalar Cross"); serializer_ok($obj,$cyclic_scalar_array,"Array Contains Scalar Cro +ss"); } { my $foo; $foo=\$foo; serializer_ok($obj,$foo,"Leaf Loop"); } { srand(19720428); my $array=[]; my $hash={}; @$array[0..9]=($hash) x 10; @$hash{0..9}=($array) x 10; $array->[int(rand(10))]=\$hash->{+int(rand(10))} for 1..5; $hash->{int(rand(10))}=\$array->[+int(rand(10))] for 1..5; serializer_ok($obj,Data::Tools->capture($array,$hash),"Big Mess"); } { my $array=[1..10]; my $hash={1..20}; serializer_ok($obj,Data::Tools->capture($array,$hash),"Simple"); } { my $foo = { "abc\000\'\efg" => "mno\000", "reftest" => \\1, }; serializer_ok($obj,$foo,"Simple Ref Test"); } { my @cc = ('c'); my $cc = \@cc; my $bb = {}; my $aa = [ 1, $bb, $cc ]; $bb->{aa} = $aa; $bb->{bb} = $aa->[1]; $bb->{cc} = $aa->[2]; serializer_ok($obj,[$aa,$bb,$cc],"Simple Ref Test 2"); } { my ($aa,$bb); $aa = [{ a => \$bb }, { b => undef }]; $bb = [{ c => \$bb }, { d => \$aa }]; serializer_ok($obj,[\$aa,\$bb],"Simple AoH"); } { my $count=0; my $build_tree; $build_tree=sub { my $depth=shift; my $parent=shift; unless (defined $depth) { $depth=4; } else { $depth--; } return unless $depth; my $ret=[]; @$ret=( $build_tree->($depth,$ret), $build_tree->($depth,$ret), $count++, $parent ); return $ret; }; my $Tree=$build_tree->(); serializer_ok($obj,$Tree,"Parent Tree"); } { my $foo = 'Foo'; my $bar = 'Bar'; my @foobars= (\$foo,\$bar); my %foobars=(foo=>\$foo,bar=>\$bar); serializer_ok($obj,Data::Tools->capture($foo,$bar,\%foobars,\@foob +ars),"Ref naming 01"); serializer_ok($obj,Data::Tools->capture($foo,$bar,\@foobars,\%foob +ars),"Ref naming 02"); serializer_ok($obj,Data::Tools->capture($foo,\@foobars,$bar,\%foob +ars),"Ref naming 03"); serializer_ok($obj,Data::Tools->capture(\@foobars,$foo,$bar,\%foob +ars),"Ref naming 04"); serializer_ok($obj,Data::Tools->capture($foo,\%foobars,$bar,\@foob +ars),"Ref naming 05"); serializer_ok($obj,Data::Tools->capture($foo,\%foobars,\@foobars,$ +bar),"Ref naming 06"); serializer_ok($obj,Data::Tools->capture($foo,\@foobars,\%foobars,$ +bar),"Ref naming 07"); serializer_ok($obj,Data::Tools->capture(\@foobars,$foo,\%foobars,$ +bar),"Ref naming 08"); serializer_ok($obj,Data::Tools->capture(\%foobars,$foo,$bar,\@foob +ars),"Ref naming 09"); serializer_ok($obj,Data::Tools->capture(\%foobars,$foo,\@foobars,$ +bar),"Ref naming 10"); serializer_ok($obj,Data::Tools->capture(\%foobars,\@foobars,$foo,$ +bar),"Ref naming 11"); serializer_ok($obj,Data::Tools->capture(\@foobars,\%foobars,$foo,$ +bar),"Ref naming 12"); serializer_ok($obj,Data::Tools->capture($bar,$foo,\%foobars,\@foob +ars),"Ref naming 13"); serializer_ok($obj,Data::Tools->capture($bar,$foo,\@foobars,\%foob +ars),"Ref naming 14"); serializer_ok($obj,Data::Tools->capture($bar,\@foobars,$foo,\%foob +ars),"Ref naming 15"); serializer_ok($obj,Data::Tools->capture(\@foobars,$bar,$foo,\%foob +ars),"Ref naming 16"); serializer_ok($obj,Data::Tools->capture($bar,\%foobars,$foo,\@foob +ars),"Ref naming 17"); serializer_ok($obj,Data::Tools->capture($bar,\%foobars,\@foobars,$ +foo),"Ref naming 18"); serializer_ok($obj,Data::Tools->capture($bar,\@foobars,\%foobars,$ +foo),"Ref naming 19"); serializer_ok($obj,Data::Tools->capture(\@foobars,$bar,\%foobars,$ +foo),"Ref naming 20"); serializer_ok($obj,Data::Tools->capture(\%foobars,$bar,$foo,\@foob +ars),"Ref naming 21"); serializer_ok($obj,Data::Tools->capture(\%foobars,$bar,\@foobars,$ +foo),"Ref naming 22"); serializer_ok($obj,Data::Tools->capture(\%foobars,\@foobars,$bar,$ +foo),"Ref naming 23"); serializer_ok($obj,Data::Tools->capture(\@foobars,\%foobars,$bar,$ +foo),"Ref naming 24"); } { #package main; my $Sub=sub{return "foo"}; my $Sub2=sub{if (@_) { print @_,"\n"; } else { print "Nothing\n"; } }; my $hash={sub1=>$Sub,sub2=>$Sub2}; my $array=[$Sub,$Sub2]; serializer_ok($obj,[$Sub],"Sub"); serializer_ok($obj,[$Sub2],"Sub2"); serializer_ok($obj,[$hash],"HoS"); serializer_ok($obj,[$array],"AoS"); serializer_ok($obj,[$array,$hash],"H&AoS"); *serializer_nok=*serializer_ok; #serializer_ok($obj,[*serializer_nok],"Sick"); } { our @dogs = ( 'Fido', 'Wags' ); our %dogs = ( goofy => 'snoopy' ); our $dogs = "hounds"; sub dogs () { "charly" }; our %kennel = ( First => \$dogs[0], Second => \$dogs[1], ); $dogs[2] = \%kennel; our $mutts = \%kennel; $mutts = $mutts; serializer_ok($obj,Data::Tools->capture(*dogs,\%kennel,$mutts), +"Dog Kennel 1"); serializer_ok($obj,[*dogs,\%kennel,$mutts],"Dog Kennel 2"); serializer_ok($obj,Data::Tools->capture(*dogs,$mutts,\%kennel),"Do +g Kennel 3"); serializer_ok($obj,[*dogs,$mutts,\%kennel],"Dog Kennel 4"); serializer_ok($obj,Data::Tools->capture($mutts,*dogs,\%kennel),"Do +g Kennel 5"); serializer_ok($obj,[$mutts,*dogs,\%kennel],"Dog Kennel 6"); serializer_ok($obj,Data::Tools->capture(\%kennel,*dogs,$mutts),"Do +g Kennel 7"); serializer_ok($obj,[\%kennel,*dogs,$mutts],"Dog Kennel 8"); serializer_ok($obj,Data::Tools->capture(\%kennel,$mutts,*dogs),"Do +g Kennel 9"); serializer_ok($obj,[\%kennel,$mutts,*dogs],"Dog Kennel 10"); serializer_ok($obj,Data::Tools->capture($mutts,\%kennel,*dogs),"Do +g Kennel 11"); serializer_ok($obj,[$mutts,\%kennel,*dogs],"Dog Kennel 12"); }

HTH

---
demerphq


Replies are listed 'Best First'.
Re: serializer tests
by xmath (Hermit) on Feb 17, 2003 at 18:04 UTC
    Thanks.. it has already helped me notice that when I recently "fixed" formatting of code refs, I actually broke them :-)

    I've included the output of my latest version (not yet uploaded)..

    I'll reupload as soon as I've fixed code refs.
    •Update: I think I fixed them. I updated the above dump too

      I'm very impressed. :-) I don't like the notation but I am very impressed indeed. A couple of niggles though. It looks like the results of the "Dog Kennel" tests are inconsistent. Id also like to see the results of

      { my ($x,$y,$z); my $to_dump=capture(capture($x,$y,$z),$x,$y,$z); }

      Ill be checking this module out very soon indeed. ++ to you.

      ---
      demerphq


        Before you complain about the notation, consider carefully whether it can be improved without losing accuracy :-)

        For example, I don't like the output of "Parent Tree", but it's a necessary evil. The output tends to look better on real-life data than on contrieved examples though.

        The "Dog Kennel" tests aren't inconsistent btw. Consider that [] copies the glob while capture() doesn't. That means the glob inside [] is an anonymous copy of *dogs, not the real thing.

        Here's the output of your snippet:

        [ [$L001, $L002, $L003], $L001: undef, $L002: undef, $L003: undef ]

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://235990]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (5)
As of 2020-05-30 13:05 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    If programming languages were movie genres, Perl would be:















    Results (172 votes). Check out past polls.

    Notices?