| Subject: | objects in set should survive |
Nice to see that Set::Array is maintained! I tried to use it for sets
of objects, which is maybe not exactly the scope of the module, but
with a few enhancements it should work ok.
I agree that for methods like "difference" the object has to be
stringified ($items1{$_}++ with $_ being the object) - but that does
not mean the stringified results should be returned!
The patch below fixes the problem for the "difference" method and
provides a test for that, but other methods need to be updated as well.
Feel free to take the patch as an example, hack on the code, etc.
Best regards,
Marek
diff -ruN Set-Array-0.11/Array.pm Set-Array-0.11.p1/Array.pm
--- Set-Array-0.11/Array.pm 2004-02-02 15:01:40.000000000 +0100
+++ Set-Array-0.11.p1/Array.pm 2004-02-03 10:23:58.000000000 +0100
@@ -725,12 +725,12 @@
($op2,$op1) = ($op1,$op2) if $reversed;
my(%item1,%item2,@diff);
- CORE::foreach(@$op1){ $item1{$_}++ }
- CORE::foreach(@$op2){ $item2{$_}++ }
+ CORE::foreach(@$op1){ $item1{$_} = $_ }
+ CORE::foreach(@$op2){ $item2{$_} = $_ }
CORE::foreach(keys %item1){
- if($item2{$_}){ next }
- CORE::push(@diff,$_);
+ if(exists $item2{$_}){ next }
+ CORE::push(@diff,$item1{$_});
}
if(want('OBJECT') || !(defined wantarray)){
diff -ruN Set-Array-0.11/test.pl Set-Array-0.11.p1/test.pl
--- Set-Array-0.11/test.pl 2004-02-02 15:00:21.000000000 +0100
+++ Set-Array-0.11.p1/test.pl 2004-02-03 10:25:05.000000000 +0100
@@ -87,3 +87,32 @@
# foreach() tests
ok($fe->foreach(sub{ $_++ }));
+
+# object test - make sure that objects are returned if set consists
+# of objects
+my $list1 = Set::Array->new(map { MyTestObj->new(value => $_) } 1..8);
+my $list2 = Set::Array->new(map { MyTestObj->new(value => $_) } 3..5);
+my @diff = $list1->difference($list2);
+my %items = map { ref($_) eq 'MyTestObj' ? ($_->value => 1) : () }
@diff;
+ok($items{1} && $items{2} && !$items{3} && !$items{4} && !$items{5} &&
+$items{6} && $items{7} && $items{8});
+
+# simple test class
+
+package MyTestObj;
+
+use overload '""' => sub {
+ "MyTestObj=".shift->value;
+};
+
+sub new
+{
+ my $class = shift;
+ $class = ref($class) if ref($class);
+ bless { @_ }, $class;
+}
+
+sub value
+{
+ shift->{value}
+}