r31486 - in /branches/upstream/libarray-unique-perl: ./ current/ current/lib/ current/lib/Array/ current/t/ current/xt/
xaviero-guest at users.alioth.debian.org
xaviero-guest at users.alioth.debian.org
Fri Mar 6 01:36:00 UTC 2009
Author: xaviero-guest
Date: Fri Mar 6 01:35:57 2009
New Revision: 31486
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=31486
Log:
[svn-inject] Installing original source of libarray-unique-perl
Added:
branches/upstream/libarray-unique-perl/
branches/upstream/libarray-unique-perl/current/
branches/upstream/libarray-unique-perl/current/Build.PL
branches/upstream/libarray-unique-perl/current/Changes
branches/upstream/libarray-unique-perl/current/MANIFEST
branches/upstream/libarray-unique-perl/current/META.yml
branches/upstream/libarray-unique-perl/current/Makefile.PL
branches/upstream/libarray-unique-perl/current/README
branches/upstream/libarray-unique-perl/current/lib/
branches/upstream/libarray-unique-perl/current/lib/Array/
branches/upstream/libarray-unique-perl/current/lib/Array/Unique.pm
branches/upstream/libarray-unique-perl/current/t/
branches/upstream/libarray-unique-perl/current/t/01regular.t
branches/upstream/libarray-unique-perl/current/t/02class.t
branches/upstream/libarray-unique-perl/current/t/03unique.t
branches/upstream/libarray-unique-perl/current/t/04false.t
branches/upstream/libarray-unique-perl/current/xt/
branches/upstream/libarray-unique-perl/current/xt/critic.t
branches/upstream/libarray-unique-perl/current/xt/pod-coverage.t
branches/upstream/libarray-unique-perl/current/xt/pod.t
Added: branches/upstream/libarray-unique-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarray-unique-perl/current/Build.PL?rev=31486&op=file
==============================================================================
--- branches/upstream/libarray-unique-perl/current/Build.PL (added)
+++ branches/upstream/libarray-unique-perl/current/Build.PL Fri Mar 6 01:35:57 2009
@@ -1,0 +1,23 @@
+use strict;
+use warnings;
+use Module::Build;
+
+use 5.006;
+
+my $builder = Module::Build->new(
+ module_name => 'Array::Unique',
+ license => 'perl',
+ dist_author => 'Gabor Szabo <gabor at pti.co.il>',
+ #dist_abstract => 'Tie-able array that allows only unique values',
+ create_makefile_pl => 'traditional',
+ create_readme => 1,
+ requires => {
+ 'perl' => '5.006',
+ },
+ build_requires => {
+ 'Test::More' => 0.47,
+ },
+);
+
+$builder->create_build_script();
+
Added: branches/upstream/libarray-unique-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarray-unique-perl/current/Changes?rev=31486&op=file
==============================================================================
--- branches/upstream/libarray-unique-perl/current/Changes (added)
+++ branches/upstream/libarray-unique-perl/current/Changes Fri Mar 6 01:35:57 2009
@@ -1,0 +1,53 @@
+Revision history for Perl extension Array::Unique.
+
+0.08 2008 June 4
+
+ Mostly CPANTS gaming
+ Change pod header to include =LICENSE
+ Some docs cleanup
+ Include authors tests in xt/
+
+0.07 2006 September 15
+ Add pod tests
+ Add missing META.yml file
+ Replace internal method Splice by _splice
+
+0.06 2004 October 2
+ Fixing a bug dropping false values from the list such ase 0 and "" (Werner Weichselberger)
+ Adding more tests.
+ Using Module::Build
+
+0.05 2003 October 11
+
+0.04 2002 December - actually uploaded to CPAN on 2003.10.11
+ added use warnings to the released version as well.
+ add tests with negative indexes and fix a minor problem
+ with negative indexes in splice.
+
+ Add '' in documentation to satisfy strict and warnings
+ Change tests to use Test::More and add Test::More requirement
+ to the makefile.
+
+ Creat a new implementation from scratch that will replace all
+ previous implementations.
+
+ Added lots of new tests. Test coverage as reported by Devel::Cover
+ is 83.3%
+
+0.03 2002 July 27
+ Nothing changed inside.
+ Added Tie::IxHash as a prequisite to the Makefile.PL file.
+
+0.02 2002 July 26
+ Fix a typo in SPLICE that caused it not working at all.
+ Add a test that would have caught this bug.
+
+ Separate implementation file from the main file.
+ Add a faster implementation using Tie::IxHash.
+ Add more test.
+
+ Improve speed by not doing a full cleanup on each
+
+0.01 2002 July 17
+ First version, everything is new.
+
Added: branches/upstream/libarray-unique-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarray-unique-perl/current/MANIFEST?rev=31486&op=file
==============================================================================
--- branches/upstream/libarray-unique-perl/current/MANIFEST (added)
+++ branches/upstream/libarray-unique-perl/current/MANIFEST Fri Mar 6 01:35:57 2009
@@ -1,0 +1,17 @@
+Changes
+Makefile.PL
+Build.PL
+MANIFEST
+README
+META.yml
+
+t/01regular.t
+t/02class.t
+t/03unique.t
+t/04false.t
+
+lib/Array/Unique.pm
+
+xt/critic.t
+xt/pod-coverage.t
+xt/pod.t
Added: branches/upstream/libarray-unique-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarray-unique-perl/current/META.yml?rev=31486&op=file
==============================================================================
--- branches/upstream/libarray-unique-perl/current/META.yml (added)
+++ branches/upstream/libarray-unique-perl/current/META.yml Fri Mar 6 01:35:57 2009
@@ -1,0 +1,21 @@
+---
+name: Array-Unique
+version: 0.08
+author:
+ - 'Gabor Szabo <gabor at pti.co.il>'
+abstract: Tie-able array that allows only unique values
+license: perl
+resources:
+ license: http://dev.perl.org/licenses/
+requires:
+ perl: 5.006
+build_requires:
+ Test::More: 0.47
+provides:
+ Array::Unique:
+ file: lib/Array/Unique.pm
+ version: 0.08
+generated_by: Module::Build version 0.2808
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
Added: branches/upstream/libarray-unique-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarray-unique-perl/current/Makefile.PL?rev=31486&op=file
==============================================================================
--- branches/upstream/libarray-unique-perl/current/Makefile.PL (added)
+++ branches/upstream/libarray-unique-perl/current/Makefile.PL Fri Mar 6 01:35:57 2009
@@ -1,0 +1,14 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.03
+use ExtUtils::MakeMaker;
+WriteMakefile
+(
+ 'NAME' => 'Array::Unique',
+ 'VERSION_FROM' => 'lib/Array/Unique.pm',
+ 'PREREQ_PM' => {
+ 'Test::More' => '0.47'
+ },
+ 'INSTALLDIRS' => 'site',
+ 'EXE_FILES' => [],
+ 'PL_FILES' => {}
+ )
+;
Added: branches/upstream/libarray-unique-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarray-unique-perl/current/README?rev=31486&op=file
==============================================================================
--- branches/upstream/libarray-unique-perl/current/README (added)
+++ branches/upstream/libarray-unique-perl/current/README Fri Mar 6 01:35:57 2009
@@ -1,0 +1,203 @@
+NAME
+ Array::Unique - Tie-able array that allows only unique values
+
+SYNOPSIS
+ use Array::Unique;
+ tie @a, 'Array::Unique';
+
+ Now use @a as a regular array.
+
+DESCRIPTION
+ This package lets you create an array which will allow only one
+ occurrence of any value.
+
+ In other words no matter how many times you put in 42 it will keep only
+ the first occurrence and the rest will be dropped.
+
+ You use the module via tie and once you tied your array to this module
+ it will behave correctly.
+
+ Uniqueness is checked with the 'eq' operator so among other things it is
+ case sensitive.
+
+ As a side effect the module does not allow undef as a value in the
+ array.
+
+EXAMPLES
+ use Array::Unique;
+ tie @a, 'Array::Unique';
+
+ @a = qw(a b c a d e f);
+ push @a, qw(x b z);
+ print "@a\n"; # a b c d e f x z
+
+DISCUSSION
+ When you are collecting a list of items and you want to make sure there
+ is only one occurrence of each item, you have several option:
+
+ 1) using an array and extracting the unique elements later
+ You might use a regular array to hold this unique set of values and
+ either remove duplicates on each update by that keeping the array
+ always unique or remove duplicates just before you want to use the
+ uniqueness feature of the array. In either case you might run a
+ function you call @a = unique_value(@a);
+
+ The problem with this approach is that you have to implement the
+ unique_value function (see later) AND you have to make sure you
+ don't forget to call it. I would say don't rely on remembering this.
+
+ There is good discussion about it in the 1st edition of the Perl
+ Cookbook of O'Reilly. I have copied the solutions here, you can see
+ further discussion in the book.
+
+ Extracting Unique Elements from a List (Section 4.6 in the Perl
+ Cookbook 1st ed.)
+
+ # Straightforward
+
+ %seen = ();
+ @uniq = ();
+ foreach $item (@list) [
+ unless ($seen{$item}) {
+ # if we get here we have not seen it before
+ $seen{$item} = 1;
+ push (@uniq, $item);
+ }
+ }
+
+ # Faster
+
+ %seen = ();
+ foreach $item (@list) {
+ push(@uniq, $item) unless $seen{$item}++;
+ }
+
+ # Faster but different
+
+ %seen;
+ foreach $item (@list) {
+ $seen{$item}++;
+ }
+ @uniq = keys %seen;
+
+ # Faster and even more different
+ %seen;
+ @uniq = grep {! $seen{$_}++} @list;
+
+ 2) using a hash
+ Some people use the keys of a hash to keep the items and put an
+ arbitrary value as the values of the hash:
+
+ To build such a list:
+
+ %unique = map { $_ => 1 } qw( one two one two three four! );
+
+ To print it:
+
+ print join ", ", sort keys %unique;
+
+ To add values to it:
+
+ $unique{$_}=1 foreach qw( one after the nine oh nine );
+
+ To remove values:
+
+ delete @unique{ qw(oh nine) };
+
+ To check if a value is there:
+
+ $unique{ $value }; # which is why I like to use "1" as my value
+
+ (thanks to Gaal Yahas for the above examples)
+
+ There are three drawbacks I see:
+
+ 1) You type more.
+ 2) Your reader might not understand at first why did you use hash
+ and what will be the values.
+ 3) You lose the order.
+
+ Usually non of them is critical but when I saw this the 10th time in
+ a code I had to understand with 0 documentation I got frustrated.
+
+ 3) using Array::Unique
+ So I decided to write this module because I got frustrated by my
+ lack of understanding what's going on in that code I mentioned.
+
+ In addition I thought it might be interesting to write this and then
+ benchmark it.
+
+ Additionally it is nice to have your name displayed in bright lights
+ all over CPAN ... or at least in a module.
+
+ Array::Unique lets you tie an array to hmmm, itself (?) and makes
+ sure the values of the array are always unique.
+
+ Since writing this I am not sure if I really recommend its usage. I
+ would say stick with the hash version and document that the variable
+ is aggregating a unique list of values.
+
+ 4) Using real SET
+ There are modules on CPAN that let you create and maintain SETs. I
+ have not checked any of those but I guess they just as much of an
+ overkill for this functionality as Unique::Array.
+
+BUGS
+ use Array::Unique;
+ tie @a, 'Array::Unique';
+
+ @c = @a = qw(a b c a d e f b);
+
+ @c will contain the same as @a AND two undefs at the end because
+ @c you get the same length as the right most list.
+
+TODO
+ Test:
+
+ Change size of the array Elements with false values ('', '0', 0)
+
+ splice:
+ splice @a;
+ splice @a, 3;
+ splice @a, -3;
+ splice @a, 3, 5;
+ splice @a, 3, -5;
+ splice @a, -3, 5;
+ splice @a, -3, -5;
+ splice @a, ?, ?, @b;
+
+ Benchmark speed
+
+ Add faster functions that don't check uniqueness so if I know part of
+ the data that comes from a unique source then I can speed up the
+ process, In short shoot myself in the leg.
+
+ Enable optional compare with other functions
+
+ Write even better implementations.
+
+AUTHOR
+ Gabor Szabo <gabor at pti.co.il>
+
+LICENSE
+ Copyright (C) 2002-2008 Gabor Szabo <gabor at pti.co.il> All rights
+ reserved. http://www.pti.co.il/
+
+ You may distribute under the terms of either the GNU General Public
+ License or the Artistic License, as specified in the Perl README file.
+
+ No WARRANTY whatsoever.
+
+CREDITS
+ Thanks for suggestions and bug reports to
+ Szabo Balazs (dLux)
+ Shlomo Yona
+ Gaal Yahas
+ Jeff 'japhy' Pinyan
+ Werner Weichselberger
+
+VERSION
+ Version: 0.08
+
+ Date: 2008 June 04
+
Added: branches/upstream/libarray-unique-perl/current/lib/Array/Unique.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarray-unique-perl/current/lib/Array/Unique.pm?rev=31486&op=file
==============================================================================
--- branches/upstream/libarray-unique-perl/current/lib/Array/Unique.pm (added)
+++ branches/upstream/libarray-unique-perl/current/lib/Array/Unique.pm Fri Mar 6 01:35:57 2009
@@ -1,0 +1,400 @@
+package Array::Unique;
+
+use 5.006;
+use strict;
+use warnings;
+use Carp;
+
+our $VERSION = '0.08';
+
+# Strips out any duplicate values (leaves the first occurrence
+# of every duplicated value and drops the later occurrences).
+# Removes all undef values.
+sub unique {
+ my $self = shift; # self or class
+
+ my %seen;
+ my @unique = grep defined $_ && !$seen{$_}++, @_;
+ # based on the Cookbook 1st edition and on suggestion by Jeff 'japhy' Pinyan
+ # fixed by Werner Weichselberger
+}
+
+
+sub TIEARRAY {
+ my $class = shift;
+ my $self = {
+ array => [],
+ hash => {},
+ };
+ bless $self, $class;
+}
+
+
+sub CLEAR {
+ my $self = shift;
+ $self->{array} = [];
+ $self->{hash} = {};
+}
+
+sub EXTEND {}
+
+sub STORE {
+ my ($self, $index, $value) = @_;
+ $self->SPLICE($index, 1, $value);
+}
+
+
+
+sub FETCHSIZE {
+ my $self = shift;
+ return scalar @{$self->{array}};
+}
+
+sub FETCH {
+ my ($self, $index) = @_;
+ ${$self->{array}}[$index];
+}
+
+
+sub STORESIZE {
+ my $self = shift;
+ my $size = shift;
+
+ # We cannot enlarge the array as the values would be undef
+
+ # But we can make it smaller
+# if ($self->FETCHSIZE > $size) {
+# $self->{->_splice($size);
+# }
+
+ $#{$self->{array}} = $size-1;
+ return $size;
+}
+
+sub SPLICE {
+ my $self = shift;
+ my $offset = shift;
+ my $length = shift;
+
+ # reset length value to positive (this is done by the normal splice too)
+ if (defined $length and $length < 0) {
+ #$length = @{$self->{array}} + $length;
+ $length += $self->FETCHSIZE - $offset;
+ }
+
+ # reset offset to positive (this is done by the normal splice too)
+ if (defined $offset and $offset < 0) {
+ $offset += $self->FETCHSIZE;
+ }
+
+ if (defined $offset and $offset > $self->FETCHSIZE) {
+ $offset = $self->FETCHSIZE;
+ # should give a warning like this: splice() offset past end of array
+ # if this was really a splice (and warning set) but no warning if this
+ # was an assignment to a high index.
+ }
+
+# my @s = @{$self->{array}}[$offset..$offset+$length]; # the old values to be returned
+ my @original;
+# if (defined $length) {
+ @original = $self->_splice($self->{array}, $offset, $length, @_);
+# } elsif (defined $offset) {
+# @original = $self->_splice($self->{array}, $offset);
+# } else {
+# @original = $self->_splice($self->{array});
+# }
+
+ return @original;
+}
+
+
+
+sub PUSH {
+ my $self = shift;
+
+ $self->SPLICE($self->FETCHSIZE, 0, @_);
+# while (my $value = shift) {
+# $self->STORE($self->FETCHSIZE+1, $value);
+# }
+ return $self->FETCHSIZE;
+}
+
+sub POP {
+ my $self = shift;
+ ($self->SPLICE(-1))[0];
+}
+
+sub SHIFT {
+ my $self = shift;
+# #($self->{array})[0];
+ ($self->SPLICE(0,1))[0];
+}
+
+sub UNSHIFT {
+ my $self = shift;
+ $self->SPLICE(0,0, at _);
+}
+
+
+sub _splice {
+ my $self = shift;
+ my $a = shift;
+ my $offset = shift;
+ my $length = shift;
+
+ my @original;
+ if (defined $length) {
+ @original = splice(@$a, $offset, $length, @_);
+ } elsif (defined $offset) {
+ @original = splice(@$a, $offset);
+ } else {
+ @original = splice(@$a);
+ }
+ @$a = $self->unique(@$a);
+ return @original;
+}
+
+=head1 NAME
+
+Array::Unique - Tie-able array that allows only unique values
+
+=head1 SYNOPSIS
+
+ use Array::Unique;
+ tie @a, 'Array::Unique';
+
+ Now use @a as a regular array.
+
+=head1 DESCRIPTION
+
+This package lets you create an array which will allow
+only one occurrence of any value.
+
+In other words no matter how many times you put in 42
+it will keep only the first occurrence and the rest will
+be dropped.
+
+You use the module via tie and once you tied your array to
+this module it will behave correctly.
+
+Uniqueness is checked with the 'eq' operator so
+among other things it is case sensitive.
+
+As a side effect the module does not allow undef as a value in the array.
+
+=head1 EXAMPLES
+
+ use Array::Unique;
+ tie @a, 'Array::Unique';
+
+ @a = qw(a b c a d e f);
+ push @a, qw(x b z);
+ print "@a\n"; # a b c d e f x z
+
+=head1 DISCUSSION
+
+When you are collecting a list of items and you want
+to make sure there is only one occurrence of each item,
+you have several option:
+
+
+=over 4
+
+=item 1) using an array and extracting the unique elements later
+
+You might use a regular array to hold this unique set of values
+and either remove duplicates on each update by that keeping the array
+always unique or remove duplicates just before you want to use the
+uniqueness feature of the array. In either case you might run a
+function you call @a = unique_value(@a);
+
+The problem with this approach is that you have to implement
+the unique_value function (see later) AND you have to make sure you
+don't forget to call it. I would say don't rely on remembering this.
+
+
+There is good discussion about it in the 1st edition of the
+Perl Cookbook of O'Reilly. I have copied the solutions here,
+you can see further discussion in the book.
+
+Extracting Unique Elements from a List (Section 4.6 in the Perl Cookbook 1st ed.)
+
+# Straightforward
+
+ %seen = ();
+ @uniq = ();
+ foreach $item (@list) [
+ unless ($seen{$item}) {
+ # if we get here we have not seen it before
+ $seen{$item} = 1;
+ push (@uniq, $item);
+ }
+ }
+
+# Faster
+
+ %seen = ();
+ foreach $item (@list) {
+ push(@uniq, $item) unless $seen{$item}++;
+ }
+
+# Faster but different
+
+ %seen;
+ foreach $item (@list) {
+ $seen{$item}++;
+ }
+ @uniq = keys %seen;
+
+ # Faster and even more different
+ %seen;
+ @uniq = grep {! $seen{$_}++} @list;
+
+
+=item 2) using a hash
+
+Some people use the keys of a hash to keep the items and
+put an arbitrary value as the values of the hash:
+
+To build such a list:
+
+ %unique = map { $_ => 1 } qw( one two one two three four! );
+
+To print it:
+
+ print join ", ", sort keys %unique;
+
+To add values to it:
+
+ $unique{$_}=1 foreach qw( one after the nine oh nine );
+
+To remove values:
+
+ delete @unique{ qw(oh nine) };
+
+To check if a value is there:
+
+ $unique{ $value }; # which is why I like to use "1" as my value
+
+(thanks to Gaal Yahas for the above examples)
+
+There are three drawbacks I see:
+
+=over 4
+
+=item 1) You type more.
+
+=item 2) Your reader might not understand at first why did you use hash
+ and what will be the values.
+
+=item 3) You lose the order.
+
+=back
+
+Usually non of them is critical but when I saw this the 10th time
+in a code I had to understand with 0 documentation I got frustrated.
+
+
+=item 3) using Array::Unique
+
+So I decided to write this module because I got frustrated
+by my lack of understanding what's going on in that code
+I mentioned.
+
+In addition I thought it might be interesting to write this and
+then benchmark it.
+
+Additionally it is nice to have your name displayed in
+bright lights all over CPAN ... or at least in a module.
+
+Array::Unique lets you tie an array to hmmm, itself (?)
+and makes sure the values of the array are always unique.
+
+Since writing this I am not sure if I really recommend its usage.
+I would say stick with the hash version and document that the
+variable is aggregating a unique list of values.
+
+
+=item 4) Using real SET
+
+There are modules on CPAN that let you create and maintain SETs.
+I have not checked any of those but I guess they just as much of
+an overkill for this functionality as Unique::Array.
+
+
+=back
+
+=head1 BUGS
+
+ use Array::Unique;
+ tie @a, 'Array::Unique';
+
+ @c = @a = qw(a b c a d e f b);
+
+ @c will contain the same as @a AND two undefs at the end because
+ @c you get the same length as the right most list.
+
+=head1 TODO
+
+Test:
+
+Change size of the array
+Elements with false values ('', '0', 0)
+
+ splice:
+ splice @a;
+ splice @a, 3;
+ splice @a, -3;
+ splice @a, 3, 5;
+ splice @a, 3, -5;
+ splice @a, -3, 5;
+ splice @a, -3, -5;
+ splice @a, ?, ?, @b;
+
+
+
+Benchmark speed
+
+Add faster functions that don't check uniqueness so if I
+know part of the data that comes from a unique source then
+I can speed up the process,
+In short shoot myself in the leg.
+
+Enable optional compare with other functions
+
+Write even better implementations.
+
+=head1 AUTHOR
+
+Gabor Szabo <gabor at pti.co.il>
+
+=head1 LICENSE
+
+Copyright (C) 2002-2008 Gabor Szabo <gabor at pti.co.il>
+All rights reserved. http://www.pti.co.il/
+
+You may distribute under the terms of either the GNU
+General Public License or the Artistic License, as
+specified in the Perl README file.
+
+No WARRANTY whatsoever.
+
+=head1 CREDITS
+
+ Thanks for suggestions and bug reports to
+ Szabo Balazs (dLux)
+ Shlomo Yona
+ Gaal Yahas
+ Jeff 'japhy' Pinyan
+ Werner Weichselberger
+
+=head1 VERSION
+
+Version: 0.08
+
+Date: 2008 June 04
+
+=cut
+
+1;
+
Added: branches/upstream/libarray-unique-perl/current/t/01regular.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarray-unique-perl/current/t/01regular.t?rev=31486&op=file
==============================================================================
--- branches/upstream/libarray-unique-perl/current/t/01regular.t (added)
+++ branches/upstream/libarray-unique-perl/current/t/01regular.t Fri Mar 6 01:35:57 2009
@@ -1,0 +1,219 @@
+
+# For testing the regular array behaviour of the module.
+# Except that this version does NOT allow undef values in the array
+# so if you put a value at an index which would leave undefs in
+# between the new value is appended to the end of the array
+
+# The tests in this file should include only unique values so they
+# whould work even with a regular array (except of the undefs).
+
+# TODO:
+# this returns strange, (undefined ?) value
+
+use strict;
+use warnings;
+use Test::More;
+#my @modes = (undef, 'Std', 'IxHash');
+#my @modes = ('Hash');
+
+#my @modes = ('default', 'standard');
+my @modes = ('default', 'standard', 'unique');
+
+# default = what we have in Perl
+# standard = using Array::Std,
+# unique = Array::Unique
+
+plan tests => (50 * @modes);
+#plan tests => (47);
+
+
+foreach my $m (@modes) {
+ unit_test($m);
+}
+exit;
+
+#######################################################
+
+sub unit_test {
+ my $mode = shift;
+
+
+my @a;
+my $o;
+my @c;
+
+
+SKIP: {
+ skip 'needed for unique only', 3 unless $mode eq 'unique';
+ eval { require Array::Unique; };
+
+ is($@, '', 'Load module Array::Unique');
+ die $@ if $@;
+
+ eval {$o = tie @a, 'Array::Unique';};
+ is($@, '', 'tie-ing an array');
+ die $@ if $@;
+ is(ref $o, 'Array::Unique', 'received Array::Unique object');
+}
+
+SKIP: {
+ skip 'needed for default only', 1 unless $mode eq 'standard';
+ require Tie::Array;
+ $o = tie @a, 'Tie::StdArray';
+ is(ref $o, 'Tie::StdArray', 'received a Tie::StdArray object');
+}
+
+# ---------------------------------------------------
+# create a simple array
+# ---------------------------------------------------
+ at c=@a=qw(a b c d);
+is(@a, 4, 'length is really 5');
+is_deeply(\@a, [qw(a b c d)], 'Create an array with simple assignement of 4 elements');
+is_deeply(\@c, [qw(a b c d)], 'create array returns the same array');
+
+
+ at c=@a=();
+is(@a, 0, 'set empty array');
+is(@c, 0, 'set empty array with returned value');
+
+
+ at a=qw(a b c d);
+
+# ---------------------------------------------------
+# fetch the value of a specific element in the array
+# ---------------------------------------------------
+is($a[0], "a", 'fetch the value of element 0');
+is($a[2], "c", 'fetch the value of element 2');
+is($a[-1], "d", 'fetch the value of element -1');
+is($a[-2], "c", 'fetch the value of element -2');
+
+
+# ---------------------------------------------------
+# set a value in a specific index
+# ---------------------------------------------------
+$a[@a] = 'e';
+is_deeply(\@a, [qw(a b c d e)],
+ 'set a value at an index higher than size of array');
+
+$a[1] = 'x';
+is_deeply(\@a, [qw(a x c d e)], 'set value in an existing index');
+
+$a[0] = 'z';
+is_deeply(\@a, [qw(z x c d e)], 'set value in an existing index (0)');
+
+$a[-1] = "p";
+is_deeply(\@a, [qw(z x c d p)], 'Set the value of negative indexes, -1');
+
+$a[-2] = "y";
+is_deeply(\@a, [qw(z x c y p)], 'Set the value of negative indexes -2');
+
+$a[@a+2] = 'q';
+# this is not even the normal behavior:
+
+SKIP: {
+ skip 'only the standard behavior', 2 unless $mode eq 'default' or
+ $mode eq 'standard';
+ is(@a, 8, 'lenght includes undefs in the middle');
+ is_deeply(\@a, ['z', 'x', 'c', 'y', 'p', undef, undef, 'q'], 'set value - with a break in the indexes');
+}
+
+SKIP: {
+ skip 'behavior only in unique module', 2 unless $mode eq 'unique';
+ is(@a, 6, 'lenght does not includ undefs in the middle as they are removed');
+ is_deeply(\@a, ['z', 'x', 'c', 'y', 'p', 'q'], 'set value - with a break in the indexes');
+}
+
+
+# ---------------------------------------------------
+# change the size of the array
+# check the size
+# ---------------------------------------------------
+my $t = $#a = 3;
+is($t, 3, 'set length returns the correct value');
+
+is($#a, 3, 'length was set correctly');
+is(@a, 4, 'number of elements is correct');
+is_deeply(\@a, [qw(z x c y)], 'array shortened correctly');
+
+$#a=0;
+is_deeply(\@a, ['z'], 'set length of 0');
+
+
+# ---------------------------------------------------
+# push
+# ---------------------------------------------------
+ at a = qw(a b c d e);
+my $length = @a;
+is_deeply([push(@a, 'f')], [$length+1], 'push one value on the array returns new size');
+is_deeply(\@a, [qw(a b c d e f)], 'push successfull');
+#print "DEBUG: '@a'\n";
+
+is_deeply([push(@a, 'g', 'h')], [$length+3], 'push returns new length');
+is_deeply(\@a, [qw(a b c d e f g h)], 'push successfull');
+
+
+# ---------------------------------------------------
+# pop
+# ---------------------------------------------------
+my $p = pop(@a);
+is($p, "h", 'pop last element works');
+is_deeply(\@a, [qw(a b c d e f g)], 'remaining array after pop is correct');
+
+
+# ---------------------------------------------------
+# shift
+# ---------------------------------------------------
+my $s = shift @a;
+is($s, "a", 'shift first element works');
+is_deeply(\@a, [qw(b c d e f g)], 'array is correct after shift');
+
+
+# ---------------------------------------------------
+# unshift
+# ---------------------------------------------------
+is_deeply([unshift @a, 'z'],[7] , 'unshift returns new length correctly');
+is_deeply(\@a, [qw(z b c d e f g)], 'unshift works correctly with one value');
+
+
+
+
+# ---------------------------------------------------
+# splice
+# ---------------------------------------------------
+my @b = splice(@a, 2, 3);
+is_deeply(\@b, [qw(c d e)], 'splice returns the cut out part');
+is_deeply(\@a, [qw(z b f g)], 'splice leaves the correct array');
+
+ at b = splice(@a, 2, 1, qw(x y w));
+is_deeply(\@b, [qw(f)], 'splice retursn the cut out part');
+is_deeply(\@a, [qw(z b x y w g)], 'splice - replace was successfull');
+
+# ---------------------------------------------------
+# splice with negative values
+# ---------------------------------------------------
+ at b = splice(@a, -1);
+is_deeply(\@b, [qw(g)], 'cut out the last element with -1');
+is_deeply(\@a, [qw(z b x y w)],'remaining all but the last element');
+
+ at a = qw(a b c d e f g h i j k);
+ at b = splice (@a, -5, 3, qw(z));
+is_deeply(\@b, [qw(g h i)], 'cut out a few elements with negative index');
+is_deeply(\@a, [qw(a b c d e f z j k)], 'inserted elements after cut out');
+
+ at b = splice(@a, 1, -1);
+is_deeply(\@a, [qw(a k)], 'negative length');
+is_deeply(\@b, [qw(b c d e f z j)], 'negative length');
+
+
+
+ at b = @a = (qw(a b c d), qw(x y z));
+is_deeply(\@a, [qw(a b c d x y z)], 'pass value of just created array');
+is_deeply(\@b, [qw(a b c d x y z)], 'pass value of just created array');
+
+my $b = @a = (qw(a b c d), qw(x y z));
+is($b, 7, 'pass scalar value of created array');
+
+}
+
+
+
Added: branches/upstream/libarray-unique-perl/current/t/02class.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarray-unique-perl/current/t/02class.t?rev=31486&op=file
==============================================================================
--- branches/upstream/libarray-unique-perl/current/t/02class.t (added)
+++ branches/upstream/libarray-unique-perl/current/t/02class.t Fri Mar 6 01:35:57 2009
@@ -1,0 +1,18 @@
+
+# testing class methods
+
+use strict;
+use warnings;
+use Test::More;
+
+plan tests => 4;
+
+use Array::Unique;
+
+is_deeply([Array::Unique->unique(qw(a s d f g))], [qw(a s d f g)], 'compare unique arrays');
+is_deeply([Array::Unique->unique(qw(a s d f a))], [qw(a s d f)], 'one extra item ');
+is_deeply([Array::Unique->unique(qw(a b b a))], [qw(a b)], 'two pairs');
+is_deeply([Array::Unique->unique('a', 'b', undef, 'b', undef, 'a', undef)], [qw(a b)], 'undefs');
+
+
+
Added: branches/upstream/libarray-unique-perl/current/t/03unique.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarray-unique-perl/current/t/03unique.t?rev=31486&op=file
==============================================================================
--- branches/upstream/libarray-unique-perl/current/t/03unique.t (added)
+++ branches/upstream/libarray-unique-perl/current/t/03unique.t Fri Mar 6 01:35:57 2009
@@ -1,0 +1,198 @@
+
+# TODO:
+# return @u = (@a, @b);
+# this returns strange, (undefined ?) value
+
+use strict;
+use warnings;
+use Test::More;
+plan tests => (29);
+
+
+# ---------------------------------------------------
+# Check if module is loading
+# ---------------------------------------------------
+eval { require Array::Unique; };
+is($@, '', 'Load module Array::Unique');
+die $@ if $@;
+
+# ---------------------------------------------------
+# New instance creation
+# ---------------------------------------------------
+my @a;
+my $o;
+
+my @b; # help variables
+my $b;
+
+eval {$o = tie @a, 'Array::Unique';};
+is($@, '', 'tie-ing an array');
+die $@ if $@;
+
+
+ at b = @a = qw(a b c a d a b q a);
+is(@a, 5, 'length is correct');
+is_deeply(\@a, [qw(a b c d q)], 'create an array where there were dupplicates');
+
+is($a[0], "a", 'fetch the value of element 0');
+is($a[3], "d", 'fetch the value of element 3');
+is($a[10], undef, 'fetch the value of too high index');
+is($a[-1], "q", 'fetch the value of element -1');
+is($a[-2], "d", 'fetch the value of element -2');
+
+
+
+TODO: {
+ local $TODO = 'transferes the length of the original list and we
+ get undefs at the end';
+is(@b, 5, 'length is correct');
+is_deeply(\@b, [qw(a b c d q)], 'transfere assignment');
+}
+
+ at b=@a;
+is(@b, 5, 'length is correct');
+
+
+$b = $a[4] = 'b';
+is_deeply(\@a, [qw(a b c d)], 'replace a value with an existing value');
+TODO: {
+ local $TODO='passing the new value not the one received';
+is($b, 'b', 'assigned value gets transfered');
+
+}
+
+$b = $a[1] = 'x';
+is_deeply(\@a, [qw(a x c d)], 'replace a value with a new value');
+is($b, 'x', 'assigned value gets transfered');
+
+
+$b = $a[1] = 'd';
+is_deeply(\@a, [qw(a d c)], 'replace a value with an existing value');
+is($b, 'd', 'assigned value gets transfered');
+
+
+$b = $a[1] = 'd';
+is_deeply(\@a, [qw(a d c)], 'replace a value in the same location');
+is($b, 'd', 'assigned value gets transfered');
+
+
+$b = $a[6] = 'a';
+is_deeply(\@a, [qw(a d c)], '');
+TODO: {
+ local $TODO='passing the new value not the one received';
+is($b, 'a', 'assigned value gets transfered');
+}
+
+
+
+# ---------------------------------------------------
+# Set the value of negative indexes
+# ---------------------------------------------------
+ at a = qw(a b c d e);
+
+$b = $a[-1] = "a";
+is_deeply(\@a, [qw(a b c d)], 'Set the value of negative indexes, -1');
+TODO: {
+ local $TODO='passing the new value not the one received';
+is($b, 'a', 'assigned value gets transfered');
+}
+
+$b = $a[-2] = "d";
+is_deeply(\@a, [qw(a b d)], 'Set the value of negative indexes -2');
+is($b, 'd', 'assigned value gets transfered');
+
+
+
+$#a=1;
+is_deeply(\@a, [qw(a b)], 'change the size of the array');
+
+is($#a, 1, 'highest index corect');
+
+is(@a, 2, 'size correct');
+
+
+=pod
+
+# ---------------------------------------------------
+# push
+# ---------------------------------------------------
+push @a, qw;
+ok("@a" eq "a b");
+#print "DEBUG: '@a'\n";
+
+push @a, 'c', 'd';
+ok("@a" eq "a b c d");
+#print "DEBUG: @a\n";
+
+push @a, qw(x y d z a);
+ok("@a" eq "a b c d x y z");
+#print "DEBUG: @a\n";
+
+=cut
+
+
+TODO: {
+ local $TODO = 'wait';
+
+
+}
+__END__
+
+
+
+
+# ---------------------------------------------------
+# splice
+# ---------------------------------------------------
+my @b = splice(@a, 2, 3);
+ok("@b" eq "c d x");
+#print "DEBUG: '@b'\n";
+ok("@a" eq "a b y z");
+#print "DEBUG: '@a'\n";
+
+ at b = splice(@a, 2, 1, qw(z a u));
+ok("@b" eq "y");
+#print "DEBUG: '@b'\n";
+ok("@a" eq "a b z u");
+#print "DEBUG: '@a'\n";
+
+# ---------------------------------------------------
+# splice with negative values
+# ---------------------------------------------------
+ at a = qw(a b c d e f g h i j k l);
+ at b = splice (@a, -1);
+is_deeply(\@b, [qw(l)], '');
+#print "DEBUG: '@b'\n";
+is_deeply(\@a, [qw(a b c d e f g h i j k)],'');
+#print "DEBUG: '@a'\n";
+
+ at b = splice (@a, -7, 4, qw(z));
+is_deeply(\@b, [qw(e f g h)], '');
+#print "DEBUG: '@b'\n";
+is_deeply(\@a, [qw(a b c d z i j k)], '');
+#print "DEBUG: '@a'\n";
+
+
+# ---------------------------------------------------
+# unshift
+# ---------------------------------------------------
+ at a = qw(a b z u);
+unshift @a, qw(d a w);
+is_deeply(\@a, [qw(d a w b z u)], '');
+#print "DEBUG: '@a'\n";
+
+
+# ---------------------------------------------------
+# pop
+# ---------------------------------------------------
+my $p = pop(@a);
+is($p, "u", '');
+is_deeply(\@a, [qw(d a w b z)], '');
+
+# ---------------------------------------------------
+# shift
+# ---------------------------------------------------
+my $s = shift @a;
+is($s, "d", '');
+is_deeply(\@a, [qw(a w b z)], '');
+
Added: branches/upstream/libarray-unique-perl/current/t/04false.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarray-unique-perl/current/t/04false.t?rev=31486&op=file
==============================================================================
--- branches/upstream/libarray-unique-perl/current/t/04false.t (added)
+++ branches/upstream/libarray-unique-perl/current/t/04false.t Fri Mar 6 01:35:57 2009
@@ -1,0 +1,11 @@
+use strict;
+use warnings;
+use Test::More "no_plan";
+
+
+use Array::Unique;
+tie my @a, 'Array::Unique';
+push @a, (1, 0, "x", "");
+is_deeply([1, 0, "x", ""], \@a, "false but defined elements are kept");
+
+
Added: branches/upstream/libarray-unique-perl/current/xt/critic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarray-unique-perl/current/xt/critic.t?rev=31486&op=file
==============================================================================
--- branches/upstream/libarray-unique-perl/current/xt/critic.t (added)
+++ branches/upstream/libarray-unique-perl/current/xt/critic.t Fri Mar 6 01:35:57 2009
@@ -1,0 +1,12 @@
+use strict;
+use warnings;
+
+use Test::More;
+eval {
+ require Test::Perl::Critic;
+ import Test::Perl::Critic;
+};
+plan skip_all => 'Test::Perl::Critic required to criticise code' if $@;
+#all_critic_ok('blib');
+all_critic_ok('blib', 't');
+
Added: branches/upstream/libarray-unique-perl/current/xt/pod-coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarray-unique-perl/current/xt/pod-coverage.t?rev=31486&op=file
==============================================================================
--- branches/upstream/libarray-unique-perl/current/xt/pod-coverage.t (added)
+++ branches/upstream/libarray-unique-perl/current/xt/pod-coverage.t Fri Mar 6 01:35:57 2009
@@ -1,0 +1,7 @@
+use Test::More;
+eval 'use Test::Pod::Coverage';
+plan skip_all => 'Needs Test::Pod::Coverage' if $@;
+#all_pod_coverage_ok();
+plan tests => 1;
+pod_coverage_ok('Array::Unique');
+
Added: branches/upstream/libarray-unique-perl/current/xt/pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarray-unique-perl/current/xt/pod.t?rev=31486&op=file
==============================================================================
--- branches/upstream/libarray-unique-perl/current/xt/pod.t (added)
+++ branches/upstream/libarray-unique-perl/current/xt/pod.t Fri Mar 6 01:35:57 2009
@@ -1,0 +1,5 @@
+use Test::More;
+eval "use Test::Pod";
+plan skip_all => 'Needs Test::Pod' if $@;
+all_pod_files_ok();
+
More information about the Pkg-perl-cvs-commits
mailing list