r3179 - in /packages/libset-object-perl/branches/upstream/current: Changes.pod MANIFEST META.yml lib/Set/Object.pm t/scalar/storable.t

[eloy at users.alioth.debian.org]

Author: eloy
Date: Wed Jun 28 10:35:02 2006
New Revision: 3179

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=3179
Log:
Load /tmp/tmp.qXrmf14063/libset-object-perl-1.15 into
packages/libset-object-perl/branches/upstream/current.

Added:
    packages/libset-object-perl/branches/upstream/current/t/scalar/storable.t
Modified:
    packages/libset-object-perl/branches/upstream/current/Changes.pod
    packages/libset-object-perl/branches/upstream/current/MANIFEST
    packages/libset-object-perl/branches/upstream/current/META.yml
    packages/libset-object-perl/branches/upstream/current/lib/Set/Object.pm

Modified: packages/libset-object-perl/branches/upstream/current/Changes.pod
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libset-object-perl/branches/upstream/current/Changes.pod?rev=3179&op=diff
==============================================================================
--- packages/libset-object-perl/branches/upstream/current/Changes.pod (original)
+++ packages/libset-object-perl/branches/upstream/current/Changes.pod Wed Jun 28 10:35:02 2006
@@ -1,5 +1,15 @@
 
 =head1 REVISION HISTORY FOR Set::Object
+
+=head1 1.15, 21 Jun 2006
+
+=over
+
+=item *
+
+Dumping sets with scalars in them via L<Storable> now works.
+
+=back
 
 =head1 1.14
 

Modified: packages/libset-object-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libset-object-perl/branches/upstream/current/MANIFEST?rev=3179&op=diff
==============================================================================
--- packages/libset-object-perl/branches/upstream/current/MANIFEST (original)
+++ packages/libset-object-perl/branches/upstream/current/MANIFEST Wed Jun 28 10:35:02 2006
@@ -37,6 +37,7 @@
 t/scalar/member.t
 t/scalar/misc.t
 t/scalar/set_set.t
+t/scalar/storable.t
 t/scalar/symmdiff.t
 t/scalar/union.t
 t/scalar/unique.t

Modified: packages/libset-object-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libset-object-perl/branches/upstream/current/META.yml?rev=3179&op=diff
==============================================================================
--- packages/libset-object-perl/branches/upstream/current/META.yml (original)
+++ packages/libset-object-perl/branches/upstream/current/META.yml Wed Jun 28 10:35:02 2006
@@ -1,7 +1,7 @@
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         Set-Object
-version:      1.14
+version:      1.15
 version_from: lib/Set/Object.pm
 installdirs:  site
 requires:

Modified: packages/libset-object-perl/branches/upstream/current/lib/Set/Object.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libset-object-perl/branches/upstream/current/lib/Set/Object.pm?rev=3179&op=diff
==============================================================================
--- packages/libset-object-perl/branches/upstream/current/lib/Set/Object.pm (original)
+++ packages/libset-object-perl/branches/upstream/current/lib/Set/Object.pm Wed Jun 28 10:35:02 2006
@@ -343,6 +343,8 @@
 
 Portions Copyright (c) 2003 - 2005, Sam Vilain.  Same license.
 
+Portions Copyright (c) 2006, Catalyst IT (NZ) Limited.  Same license.
+
 =head1 SEE ALSO
 
 perl(1), perltie(1), L<Set::Scalar>, overload.pm
@@ -366,7 +368,7 @@
 
 @EXPORT_OK = qw( ish_int is_int is_string is_double blessed reftype
 		 refaddr is_overloaded is_object is_key set );
-$VERSION = '1.14';
+$VERSION = '1.15';
 
 bootstrap Set::Object $VERSION;
 
@@ -808,13 +810,18 @@
 sub STORABLE_freeze {
     my $obj = shift;
     my $am_cloning = shift;
-    return ("", $obj->members);
+    return ("v2", [ $obj->members ]);
 }
 
 use Devel::Peek qw(Dump);
 
 sub STORABLE_thaw {
     #print Dump $_ foreach (@_);
+
+    $DB::single = 1;
+    if ( $_[2] and $_[2] eq "v2" ) {
+	@_ = (@_[0,1], "", @{ $_[3] });
+    }
 
     goto &_STORABLE_thaw;
     #print "Got here\n";

Added: packages/libset-object-perl/branches/upstream/current/t/scalar/storable.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libset-object-perl/branches/upstream/current/t/scalar/storable.t?rev=3179&op=file
==============================================================================
--- packages/libset-object-perl/branches/upstream/current/t/scalar/storable.t (added)
+++ packages/libset-object-perl/branches/upstream/current/t/scalar/storable.t Wed Jun 28 10:35:02 2006
@@ -1,0 +1,47 @@
+#  -*- cperl -*-
+#
+#  Storable test for Set::Object objects
+
+use strict;
+
+BEGIN {
+    eval "use Storable qw(freeze thaw dclone)";
+    if ($@) {
+	eval 'use Test::More skip_all => "Storable not installed"';
+	exit(0);
+    } else {
+	eval 'use Test::More tests => 7';
+    }
+}
+
+use_ok("Set::Object", qw(refaddr));
+my $objects = [ qw(Barnie Fred Wilma)                 ];
+
+my $stored = freeze ($objects);
+is_deeply(thaw($stored), $objects, "Storable works");
+
+my $set = Set::Object->new(@$objects);
+$stored = freeze($set);
+
+use Data::Dumper;
+#print Dumper $stored;
+
+my $returned = thaw($stored);
+#print "no segfault yet!\n";
+#diag(Dumper($returned, $set));
+is_deeply([ sort { ref($a) cmp ref($b) } $returned->members ],
+	  [ sort { ref($a) cmp ref($b) } $set->members ],
+	  "Set::Object serialises via Storable!");
+isnt($$returned, $$set, "thaw returned a new Set::Object");
+
+my $spawned = dclone($set);
+is_deeply([ sort { ref($a) cmp ref($b) } $spawned->members ],
+	  [ sort { ref($a) cmp ref($b) } $set->members ],
+	  "Set::Object dclones via Storable!");
+isnt($$spawned, $$set, "dclone returned a new Set::Object");
+
+my $old;
+my $test = dclone ($old = [ map { Set::Object->new() } (1..1000) ]);
+
+is(@$old, @$test, "empty sets");
+