r8137 - in /branches/upstream/libset-object-perl/current: Changes.pod MANIFEST META.yml lib/Set/Object.pm lib/Set/Object/Weak.pm t/object/SetSubClass.pm t/object/set_subclass.t
rmayorga-guest at users.alioth.debian.org
rmayorga-guest at users.alioth.debian.org
Tue Oct 9 17:14:50 UTC 2007
Author: rmayorga-guest
Date: Tue Oct 9 17:14:49 2007
New Revision: 8137
URL: http://svn.debian.org/wsvn/?sc=1&rev=8137
Log:
[svn-upgrade] Integrating new upstream version, libset-object-perl (1.22)
Added:
branches/upstream/libset-object-perl/current/t/object/SetSubClass.pm
branches/upstream/libset-object-perl/current/t/object/set_subclass.t
Modified:
branches/upstream/libset-object-perl/current/Changes.pod
branches/upstream/libset-object-perl/current/MANIFEST
branches/upstream/libset-object-perl/current/META.yml
branches/upstream/libset-object-perl/current/lib/Set/Object.pm
branches/upstream/libset-object-perl/current/lib/Set/Object/Weak.pm
Modified: branches/upstream/libset-object-perl/current/Changes.pod
URL: http://svn.debian.org/wsvn/branches/upstream/libset-object-perl/current/Changes.pod?rev=8137&op=diff
==============================================================================
--- branches/upstream/libset-object-perl/current/Changes.pod (original)
+++ branches/upstream/libset-object-perl/current/Changes.pod Tue Oct 9 17:14:49 2007
@@ -1,5 +1,19 @@
+
+=encoding utf8
=head1 REVISION HISTORY FOR Set::Object
+
+=head1 1.22, 8 Oct 2007
+
+=over
+
+=item *
+
+Sub-classing interface added; it is now much easier to make
+L<Set::Object> subclasses that return objects other than more
+L<Set::Object>s when subclassing. From BrÃan Mach Aon Innéirghthe.
+
+=back
=head1 1.21, 17 Feb 2007
Modified: branches/upstream/libset-object-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libset-object-perl/current/MANIFEST?rev=8137&op=diff
==============================================================================
--- branches/upstream/libset-object-perl/current/MANIFEST (original)
+++ branches/upstream/libset-object-perl/current/MANIFEST Tue Oct 9 17:14:49 2007
@@ -25,6 +25,8 @@
t/object/properties.t
t/object/storable.t
t/object/weakref.t
+t/object/SetSubClass.pm
+t/object/set_subclass.t
t/scalar/basic_overload.t
t/scalar/basic.t
Modified: branches/upstream/libset-object-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libset-object-perl/current/META.yml?rev=8137&op=diff
==============================================================================
--- branches/upstream/libset-object-perl/current/META.yml (original)
+++ branches/upstream/libset-object-perl/current/META.yml Tue Oct 9 17:14:49 2007
@@ -1,10 +1,10 @@
# 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.21
+version: 1.22
version_from: lib/Set/Object.pm
installdirs: site
requires:
distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
+generated_by: ExtUtils::MakeMaker version 6.30_01
Modified: branches/upstream/libset-object-perl/current/lib/Set/Object.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libset-object-perl/current/lib/Set/Object.pm?rev=8137&op=diff
==============================================================================
--- branches/upstream/libset-object-perl/current/lib/Set/Object.pm (original)
+++ branches/upstream/libset-object-perl/current/lib/Set/Object.pm Tue Oct 9 17:14:49 2007
@@ -77,6 +77,13 @@
Return a new C<Set::Object> filled with C<@members>. You have to
explicitly import this method.
+
+B<New in Set::Object 1.22>: this function is now called as a method
+to return new sets the various methods that return a new set, such as
+C<-E<gt>intersection>, C<-E<gt>union>, etc and their overloaded
+counterparts. The default method always returns C<Set::Object>
+objects, preserving previous behaviour and not second guessing the
+nature of your derived L<Set::Object> class.
=head2 C<weak_set()>
@@ -490,7 +497,7 @@
@EXPORT_OK = qw( ish_int is_int is_string is_double blessed reftype
refaddr is_overloaded is_object is_key set weak_set );
-$VERSION = '1.21';
+$VERSION = '1.22';
bootstrap Set::Object $VERSION;
@@ -505,7 +512,7 @@
croak "Tried to use as_string on something other than a Set::Object"
unless (UNIVERSAL::isa($self, __PACKAGE__));
- 'Set::Object(' . (join ' ', sort { $a cmp $b }
+ ref($self).'(' . (join ' ', sort { $a cmp $b }
$self->members) . ')'
}
@@ -524,7 +531,7 @@
sub union
{
- Set::Object->new
+ $_[0]->set
( map { $_->members() }
grep { UNIVERSAL::isa($_, __PACKAGE__) }
@_ );
@@ -537,7 +544,7 @@
if (ref $_[0]) {
$other = shift;
} else {
- $other = __PACKAGE__->new(shift);
+ $other = $self->set(shift);
}
croak("Tried to form union between Set::Object & "
@@ -551,14 +558,12 @@
sub intersection
{
my $s = shift;
- return Set::Object->new() unless $s;
-
- my $rem = __PACKAGE__->new($s->members);
+ my $rem = $s->set($s->members);
while ($s = shift)
{
if (!ref $s) {
- $s = __PACKAGE__->new($s);
+ $s = $rem->new($s);
}
croak("Tried to form intersection between Set::Object & "
@@ -577,7 +582,7 @@
if (ref $_[0]) {
$s2 = shift;
} else {
- $s2 = __PACKAGE__->new(shift);
+ $s2 = $s1->set(shift);
}
my $r = shift;
if ( $r ) {
@@ -604,9 +609,9 @@
my $s;
if ( $r ) {
- $s = Set::Object->new( grep { !$s1->includes($_) } $s2->members );
+ $s = $s2->set( grep { !$s1->includes($_) } $s2->members );
} else {
- $s = Set::Object->new( grep { !$s2->includes($_) } $s1->members );
+ $s = $s1->set( grep { !$s2->includes($_) } $s1->members );
}
$s;
}
@@ -625,7 +630,7 @@
."`$other'")
if ref $other and not UNIVERSAL::isa($other, __PACKAGE__);
- my $result = Set::Object->new( $self->members() );
+ my $result = $self->set( $self->members() );
$result->invert( $other->members() );
return $result;
@@ -1057,6 +1062,9 @@
}
sub set {
+ if (eval { $_[0]->isa(__PACKAGE__) }) {
+ shift;
+ }
__PACKAGE__->new(@_);
}
sub weak_set {
Modified: branches/upstream/libset-object-perl/current/lib/Set/Object/Weak.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libset-object-perl/current/lib/Set/Object/Weak.pm?rev=8137&op=diff
==============================================================================
--- branches/upstream/libset-object-perl/current/lib/Set/Object/Weak.pm (original)
+++ branches/upstream/libset-object-perl/current/lib/Set/Object/Weak.pm Tue Oct 9 17:14:49 2007
@@ -29,6 +29,7 @@
use base qw(Exporter); # my users would hate me otherwise
use vars qw(@ISA @EXPORT_OK);
+use Set::Object qw(blessed);
our @EXPORT_OK = qw(weak_set set);
@@ -79,7 +80,11 @@
=cut
sub set {
- __PACKAGE__->new(@_);
+ my $class = __PACKAGE__;
+ if (blessed $_[0] and $_[0]->isa("Set::Object")) {
+ $class = "Set::Object";
+ }
+ $class->new(@_);
}
1;
Added: branches/upstream/libset-object-perl/current/t/object/SetSubClass.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libset-object-perl/current/t/object/SetSubClass.pm?rev=8137&op=file
==============================================================================
--- branches/upstream/libset-object-perl/current/t/object/SetSubClass.pm (added)
+++ branches/upstream/libset-object-perl/current/t/object/SetSubClass.pm Tue Oct 9 17:14:49 2007
@@ -1,0 +1,16 @@
+package SetSubClass;
+use strict;
+use warnings;
+
+use base qw(Set::Object);
+
+sub set {
+ if (eval { $_[0]->isa(__PACKAGE__) }) {
+ shift;
+ }
+ __PACKAGE__->new(@_);
+}
+
+
+
+1; # Magic true value required at end of module
Added: branches/upstream/libset-object-perl/current/t/object/set_subclass.t
URL: http://svn.debian.org/wsvn/branches/upstream/libset-object-perl/current/t/object/set_subclass.t?rev=8137&op=file
==============================================================================
--- branches/upstream/libset-object-perl/current/t/object/set_subclass.t (added)
+++ branches/upstream/libset-object-perl/current/t/object/set_subclass.t Tue Oct 9 17:14:49 2007
@@ -1,0 +1,22 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More tests => 4;
+require 't/object/SetSubClass.pm';
+
+
+my $sd1 = SetSubClass::set( 1,2,3,4 );
+my $sd2 = SetSubClass::set(3,4,5,6);
+
+my $union = $sd1->union($sd2);
+isa_ok( $union, 'SetSubClass', "union of SetSubClass with SetSubClass" );
+
+my $intersection = $sd1->intersection($sd2);
+isa_ok( $union, 'SetSubClass', "intersection of SetSubClass with SetSubClass" );
+
+my $difference = $sd1->difference($sd2);
+isa_ok( $difference, 'SetSubClass', "difference of SetSubClass with SetSubClass" );
+
+my $invert = $sd1 / $sd2;
+isa_ok( $invert, 'SetSubClass', "invert of SetSubClass with SetSubClass" );
+
More information about the Pkg-perl-cvs-commits
mailing list