r10095 - in /branches/upstream/libarray-compare-perl: ./ current/ current/lib/ current/lib/Array/ current/t/
vdanjean at users.alioth.debian.org
vdanjean at users.alioth.debian.org
Sat Dec 1 11:49:49 UTC 2007
Author: vdanjean
Date: Sat Dec 1 11:49:49 2007
New Revision: 10095
URL: http://svn.debian.org/wsvn/?sc=1&rev=10095
Log:
[svn-inject] Installing original source of libarray-compare-perl
Added:
branches/upstream/libarray-compare-perl/
branches/upstream/libarray-compare-perl/current/
branches/upstream/libarray-compare-perl/current/Build.PL
branches/upstream/libarray-compare-perl/current/Changes
branches/upstream/libarray-compare-perl/current/MANIFEST
branches/upstream/libarray-compare-perl/current/META.yml
branches/upstream/libarray-compare-perl/current/Makefile.PL
branches/upstream/libarray-compare-perl/current/README
branches/upstream/libarray-compare-perl/current/lib/
branches/upstream/libarray-compare-perl/current/lib/Array/
branches/upstream/libarray-compare-perl/current/lib/Array/Compare.pm
branches/upstream/libarray-compare-perl/current/t/
branches/upstream/libarray-compare-perl/current/t/pod.t
branches/upstream/libarray-compare-perl/current/t/pod_coverage.t
branches/upstream/libarray-compare-perl/current/t/test.t
Added: branches/upstream/libarray-compare-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libarray-compare-perl/current/Build.PL?rev=10095&op=file
==============================================================================
--- branches/upstream/libarray-compare-perl/current/Build.PL (added)
+++ branches/upstream/libarray-compare-perl/current/Build.PL Sat Dec 1 11:49:49 2007
@@ -1,0 +1,10 @@
+use Module::Build;
+my $build = new Module::Build(module_name => 'Array::Compare',
+ license => 'perl',
+ requires => {
+ perl => '5.6.0',
+ },
+ create_makefile_pl => 'passthrough'
+ );
+$build->create_build_script;
+
Added: branches/upstream/libarray-compare-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libarray-compare-perl/current/Changes?rev=10095&op=file
==============================================================================
--- branches/upstream/libarray-compare-perl/current/Changes (added)
+++ branches/upstream/libarray-compare-perl/current/Changes Sat Dec 1 11:49:49 2007
@@ -1,0 +1,41 @@
+2004-10-23 09:11 dave
+
+ * lib/Array/Compare.pm (1.11), t/test.t (1.2): Improved test
+ coverage
+
+2004-10-22 21:32 dave
+
+ * lib/Array/Compare.pm (1.10): Improved docs for full comparison
+ * t/pod.t (1.2): Updated pod tests
+
+2004-05-13 21:01 dave
+
+ * README.xml (1.3): Small formatting changes
+
+2004-05-12 23:52 dave
+
+ * Makefile.PL (1.1): Added Makefile.PL
+ * MANIFEST (1.1), t/pod.t (1.1), t/test.t (1.1): Added various
+ files to cvs
+
+2003-09-19 10:37 dave
+
+ * lib/Array/Compare.pm (1.9): Bring CVS version into line with old
+ file
+ * Build.PL (1.1), Compare.pm (1.8), README.xml (1.2), test.pl
+ (1.2), lib/Array/Compare.pm (1.1): Bit of an overhaul
+
+2002-03-29 17:45 dave
+
+ * Compare.pm (1.7): Test version
+ * README.xml (1.1): README input file
+ * test.pl (1.1): Test script.
+
+2002-01-09 11:41 dave
+
+ * Compare.pm (1.6): Small cleanups
+
+2001-12-09 19:31 dave
+
+ * Compare.pm (1.5): Cleanup.
+
Added: branches/upstream/libarray-compare-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libarray-compare-perl/current/MANIFEST?rev=10095&op=file
==============================================================================
--- branches/upstream/libarray-compare-perl/current/MANIFEST (added)
+++ branches/upstream/libarray-compare-perl/current/MANIFEST Sat Dec 1 11:49:49 2007
@@ -1,0 +1,10 @@
+Build.PL
+Makefile.PL
+Changes
+lib/Array/Compare.pm
+MANIFEST
+META.yml
+README
+t/pod.t
+t/test.t
+t/pod_coverage.t
Added: branches/upstream/libarray-compare-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libarray-compare-perl/current/META.yml?rev=10095&op=file
==============================================================================
--- branches/upstream/libarray-compare-perl/current/META.yml (added)
+++ branches/upstream/libarray-compare-perl/current/META.yml Sat Dec 1 11:49:49 2007
@@ -1,0 +1,14 @@
+---
+name: Array-Compare
+version: 1.13
+author:
+ - Dave Cross <dave at mag-sol.com>
+abstract: Perl extension for comparing arrays.
+license: perl
+requires:
+ perl: 5.6.0
+provides:
+ Array::Compare:
+ file: lib/Array/Compare.pm
+ version: 1.13
+generated_by: Module::Build version 0.261
Added: branches/upstream/libarray-compare-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libarray-compare-perl/current/Makefile.PL?rev=10095&op=file
==============================================================================
--- branches/upstream/libarray-compare-perl/current/Makefile.PL (added)
+++ branches/upstream/libarray-compare-perl/current/Makefile.PL Sat Dec 1 11:49:49 2007
@@ -1,0 +1,31 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.03
+
+ unless (eval "use Module::Build::Compat 0.02; 1" ) {
+ print "This module requires Module::Build to install itself.\n";
+
+ require ExtUtils::MakeMaker;
+ my $yn = ExtUtils::MakeMaker::prompt
+ (' Install Module::Build now from CPAN?', 'y');
+
+ unless ($yn =~ /^y/i) {
+ die " *** Cannot install without Module::Build. Exiting ...\n";
+ }
+
+ require Cwd;
+ require File::Spec;
+ require CPAN;
+
+ # Save this 'cause CPAN will chdir all over the place.
+ my $cwd = Cwd::cwd();
+ my $makefile = File::Spec->rel2abs($0);
+
+ CPAN::Shell->install('Module::Build::Compat')
+ or die " *** Cannot install without Module::Build. Exiting ...\n";
+
+ chdir $cwd or die "Cannot chdir() back to $cwd: $!";
+ }
+ eval "use Module::Build::Compat 0.02; 1" or die $@;
+ use lib '_build/lib';
+ Module::Build::Compat->run_build_pl(args => \@ARGV);
+ require Module::Build;
+ Module::Build::Compat->write_makefile(build_class => 'Module::Build');
Added: branches/upstream/libarray-compare-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libarray-compare-perl/current/README?rev=10095&op=file
==============================================================================
--- branches/upstream/libarray-compare-perl/current/README (added)
+++ branches/upstream/libarray-compare-perl/current/README Sat Dec 1 11:49:49 2007
@@ -1,0 +1,72 @@
+
+Array::Compare
+--------------
+
+NAME
+
+ Array::Compare
+
+DESCRIPTION
+
+WHAT IS Array::Compare?
+
+ Array::Compare is a Perl module which allows you to compare two arrays.
+
+ It has a number of features which allow you to control the way that the
+ arrays are compared:
+
+ * white space in array elements can be significant or ignored.
+ * particular columns in the arrays can be ignored.
+
+ Additionally you can get a simple true/false return value or the number
+ of columns which differ or an array containing the indexes of the
+ differing columns.
+
+HOW DO I INSTALL IT?
+
+ Array::Compare uses the standard Perl module architecture and can
+ therefore by installed using the standard Perl method which, in brief,
+ goes something like this:
+
+ gzip -cd Array-Compare-X.XX.tar.gz | tar xvf -
+ cd Array-Compare-X.XX
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+ Where X.XX is the version number of the module which you are installing.
+
+ If this doesn't work for you then creating a directory called Array
+ somewhere in your Perl library path (@INC) and copying the Compare.pm
+ file into this directory should also do the trick.
+
+WHERE IS THE DOCUMENTATION?
+
+ All of the documentation is currently in POD format in the Compare.pm
+ file. If you install the module using the standard method you should be
+ able to read it by typing
+
+ perldoc Array::Compare
+
+ at a comand prompt.
+
+LATEST VERSION
+
+ The latest version of this module will always be available from CPAN.
+
+COPYRIGHT
+
+ Copyright (C) 2003, Magnum Solutions Ltd. All Rights Reserved.
+
+ This module is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself.
+
+ANYTHING ELSE?
+
+ If you have any further questions, please contact the author.
+
+AUTHOR
+
+ Dave Cross <dave at mag-sol.com>
+
Added: branches/upstream/libarray-compare-perl/current/lib/Array/Compare.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libarray-compare-perl/current/lib/Array/Compare.pm?rev=10095&op=file
==============================================================================
--- branches/upstream/libarray-compare-perl/current/lib/Array/Compare.pm (added)
+++ branches/upstream/libarray-compare-perl/current/lib/Array/Compare.pm Sat Dec 1 11:49:49 2007
@@ -1,0 +1,551 @@
+#
+# $Id: Compare.pm,v 1.13 2005/09/21 09:23:40 dave Exp $
+#
+
+=head1 NAME
+
+Array::Compare - Perl extension for comparing arrays.
+
+=head1 SYNOPSIS
+
+ use Array::Compare;
+
+ my $comp1 = Array::Compare->new;
+ $comp->Sep('|');
+ $comp->Skip({3 => 1, 4 => 1});
+ $comp->WhiteSpace(0);
+ $comp->Case(1);
+
+ my $comp2 = Array::Compare->new(Sep => '|',
+ WhiteSpace => 0,
+ Case => 1,
+ Skip => {3 => 1, 4 => 1});
+
+ my @arr1 = 0 .. 10;
+ my @arr2 = 0 .. 10;
+
+ $comp1->compare(\@arr1, \@arr2);
+ $comp2->compare(\@arr1, \@arr2);
+
+=head1 DESCRIPTION
+
+If you have two arrays and you want to know if they are the same or
+different, then Array::Compare will be useful to you.
+
+All comparisons are carried out via a comparator object. In the
+simplest usage, you can create and use a comparator object like
+this:
+
+ my @arr1 = 0 .. 10;
+ my @arr2 = 0 .. 10;
+
+ my $comp = Array::Compare->new;
+
+ if ($comp->compare(\@arr1, \@arr2)) {
+ print "Arrays are the same\n";
+ } else {
+ print "Arrays are different\n";
+ }
+
+Notice that you pass references to the two arrays to the comparison
+method.
+
+Internally the comparator compares the two arrays by using C<join>
+to turn both arrays into strings and comparing the strings using
+C<eq>. In the joined strings, the elements of the original arrays
+are separated with the C<^G> character. This can cause problems if
+your array data contains C<^G> characters as it is possible that
+two different arrays can be converted to the same string.
+
+To avoid this, it is possible to override the default separator
+character, either by passing and alternative to the C<new> function
+
+ my $comp = Array::Compare->new(Sep => '|');
+
+or by changing the seperator for an existing comparator object
+
+ $comp->Sep('|');
+
+In general you should choose a separator character that won't appear
+in your data.
+
+You can also control whether or not whitespace within the elements of
+the arrays should be considered significant when making the comparison.
+The default is that all whitespace is significant. The alternative is
+for all consecutive white space characters to be converted to a single
+space for the pruposes of the comparison. Again, this can be turned on
+when creating a comparator object:
+
+ my $comp = Array::Compare->new(WhiteSpace => 0);
+
+or by altering an existing object:
+
+ $comp->WhiteSpace(0);
+
+You can also control whether or not the case of the data is significant
+in the comparison. The default is that the case of data is taken into
+account. This can be changed in the standard ways when creating a new
+comparator object:
+
+ my $comp = Array::Compare->new(Case => 0);
+
+or by altering an existing object:
+
+ $comp->Case(0);
+
+In addition to the simple comparison described above (which returns true
+if the arrays are the same and false if they're different) there is also
+a full comparison which returns a list containing the indexes of elements
+which differ between the two arrays. If the arrays are the same it returns
+an empty list. In scalar context the full comparison returns the length of
+this list (i.e. the number of elements that differ). You can access the full
+comparision in two ways. Firstly, there is a C<DefFull> attribute. If this
+is C<true> then a full comparison if carried out whenever the C<compare>
+method is called.
+
+ my $comp = Array::Compare->new(DefFull => 1);
+ $comp->compare(\@arr1, \@arr2); # Full comparison
+
+ $comp->DefFull(0);
+ $comp->compare(\@arr1, \@arr2); # Simple comparison
+
+ $comp->DefFull(1);
+ $comp->compare(\@arr1, \@arr2); # Full comparison again
+
+
+Secondly, you can access the full comparison method directly
+
+ $comp->full_compare(\@arr1, \@arr2);
+
+For symmetry, there is also a direct method to use to call the simple
+comparison.
+
+ $comp->simple_compare(\@arr1, \@arr2);
+
+The final complication is the ability to skip elements in the comparison.
+If you know that two arrays will always differ in a particular element
+but want to compare the arrays I<ignoring> this element, you can do it
+with Array::Compare without taking array slices. To do this, a
+comparator object has an optional attribute called C<Skip> which is a
+reference to a hash. The keys in this hash are the indexes of the array
+elements and the values should be any true value for elements that should
+be skipped.
+
+For example, if you want to compare two arrays, ignoring the values in
+elements two and four, you can do something like this:
+
+ my %skip = (2 => 1, 4 => 1);
+ my @a = (0, 1, 2, 3, 4, 5);
+ my @b = (0, 1, X, 3, X, 5);
+
+ my $comp = Array::Compare->new(Skip => \%skip);
+
+ $comp->compare(\@a, \@b);
+
+This should return I<true>, as we are explicitly ignoring the columns
+which differ.
+
+Of course, having created a comparator object with no skip hash, it is
+possible to add one later:
+
+ $comp->Skip({1 => 1, 2 => 1});
+
+or:
+
+ my %skip = (1 => 1, 2 => 2);
+ $comp->Skip(\%skip);
+
+To reset the comparator so that no longer skips elements, set the skip
+hash to an empty hash.
+
+ $comp->Skip({});
+
+You can also check to see if one array is a permutation of another, i.e.
+they contain the same elements but in a different order.
+
+ if ($comp->perm(\@a, \@b) {
+ print "Arrays are perms\n";
+ else {
+ print "Nope. Arrays are completely different\n";
+ }
+
+In this case the values of C<WhiteSpace> and C<Case> are still used,
+but C<Skip> is ignored for, hopefully, obvious reasons.
+
+=head1 METHODS
+
+=cut
+
+package Array::Compare;
+
+use strict;
+use vars qw($VERSION $AUTOLOAD);
+
+use Carp;
+
+$VERSION = sprintf "%d.%02d", '$Revision: 1.13 $ ' =~ /(\d+)\.(\d+)/;
+
+my %_defaults = (Sep => '^G',
+ WhiteSpace => 1,
+ Case => 1,
+ Skip => {},
+ DefFull => 0);
+
+=head2 new [ %OPTIONS ]
+
+Constructs a new comparison object.
+
+Takes an optional hash containing various options that control how
+comparisons are carried out. Any omitted options take useful defaults.
+
+=over 4
+
+=item Sep
+
+This is the value that is used to separate fields when the array is joined
+into a string. It should be a value which doesn't appear in your data.
+Default is '^G'.
+
+=item WhiteSpace
+
+Flag that indicates whether or not whitespace is significant in the
+comparison. If this value is true then all multiple whitespace characters
+are changed into a single space before the comparison takes place. Default
+is 1 (whitespace is significant).
+
+=item Case
+
+Flag that indicates whther or not the case of the data should be significant
+in the comparison. Default is 1 (case is significant).
+
+=item Skip
+
+a reference to a hash which contains the numbers of any columns that should
+be skipped in the comparison. Default is an empty hash (all columns are
+significant).
+
+=item DefFull
+
+Flag which indicates whether the default comparison is simple (just returns
+true if the arrays are the same or false if they're not) or full (returns an
+array containing the indexes of the columns that differ). Default is 0 (simple
+comparison).
+
+=back
+
+=cut
+
+sub new {
+ my $class = shift;
+
+ my $self = {%_defaults, @_};
+
+ bless $self, $class;
+
+ return $self;
+}
+
+#
+# Utility function to check the arguments to any of the comparison
+# function. Ensures that there are two arguments and that they are
+# both arrays.
+#
+sub _check_args {
+ my $self = shift;
+ croak('Must compare two arrays.') unless @_ == 2;
+ croak('Argument 1 is not an array') unless ref($_[0]) eq 'ARRAY';
+ croak('Argument 2 is not an array') unless ref($_[1]) eq 'ARRAY';
+
+ return;
+}
+
+=head2 compare_len \@ARR1, \@ARR2
+
+Very simple comparison. Just checks the lengths of the arrays are
+the same.
+
+=cut
+
+sub compare_len {
+ my $self = shift;
+
+ $self->_check_args(@_);
+
+ return @{$_[0]} == @{$_[1]};
+}
+
+=head2 compare \@ARR1, \@ARR2
+
+Compare the values in two arrays and return a data indicating whether
+the arrays are the same. The exact return values differ depending on
+the comparison method used. See the descriptions of L<simple_compare>
+and L<full_compare> for details.
+
+Uses the value of DefFull to determine which comparison routine
+to use.
+
+=cut
+
+sub compare {
+ my $self = shift;
+
+ if ($self->DefFull) {
+ return $self->full_compare(@_);
+ } else {
+ return $self->simple_compare(@_);
+ }
+}
+
+=head2 simple_compare \@ARR1, \@ARR2
+
+Compare the values in two arrays and return a flag indicating whether or
+not the arrays are the same.
+
+Returns true if the arrays are the same or false if they differ.
+
+Uses the values of 'Sep', 'WhiteSpace' and 'Skip' to influence
+the comparison.
+
+=cut
+
+sub simple_compare {
+ my $self = shift;
+
+ $self->_check_args(@_);
+
+ my ($row1, $row2) = @_;
+
+ # No point in continuing if the number of elements is different.
+ return unless $self->compare_len(@_);
+
+ # @check contains the indexes into the two arrays, i.e. the numbers
+ # from 0 to one less than the number of elements.
+ my @check = 0 .. $#$row1;
+
+ my ($pkg, $caller) = (caller(1))[0, 3];
+ my $perm = $caller eq __PACKAGE__ . "::perm";
+
+ # Filter @check so it only contains indexes that should be compared.
+ # N.B. Makes no sense to do this if we are called from 'perm'.
+ unless ($perm) {
+ @check = grep {!(exists $self->Skip->{$_}
+ && $self->Skip->{$_}) } @check
+ if keys %{$self->Skip};
+ }
+
+ # Build two strings by taking array slices containing only the columns
+ # that we shouldn't skip and joining those array slices using the Sep
+ # character. Hopefully we can then just do a string comparison.
+ # Note: this makes the function liable to errors if your arrays
+ # contain the separator character.
+ my $str1 = join($self->Sep, @{$row1}[@check]);
+ my $str2 = join($self->Sep, @{$row2}[@check]);
+
+ # If whitespace isn't significant, collapse it
+ unless ($self->WhiteSpace) {
+ $str1 =~ s/\s+/ /g;
+ $str2 =~ s/\s+/ /g;
+ }
+
+ # If case isn't significant, change to lower case
+ unless ($self->Case) {
+ $str1 = lc $str1;
+ $str2 = lc $str2;
+ }
+
+ return $str1 eq $str2;
+}
+
+=head2 full_compare \@ARR1, \@ARR2
+
+Do a full comparison between two arrays.
+
+Checks each individual column. In scalar context returns the number
+of columns that differ (zero if the arrays are the same). In list
+context returns an list containing the indexes of the columns that
+differ (an empty list if the arrays are the same).
+
+Uses the values of 'Sep' and 'WhiteSpace' to influence the comparison.
+
+B<Note:> If the two arrays are of different lengths then this method
+just returns the indexes of the elements that appear in one array but
+not the other (i.e. the indexes from the longer array that are beyond
+the end of the shorter array). This might be a little
+counter-intuitive.
+
+=cut
+
+sub full_compare {
+ my $self = shift;
+
+ $self->_check_args(@_);
+
+ my ($row1, $row2) = @_;
+
+ # No point in continuing if the number of elements is different.
+ # Because of the expected return value from this function we can't
+ # just say 'the arrays are different'. We need to do some work to
+ # calculate a meaningful return value.
+ # If we've been called in array context we return a list containing
+ # the number of the columns that appear in the longer list and aren't
+ # in the shorter list. If we've been called in scalar context we
+ # return the difference in the lengths of the two lists.
+ unless ($self->compare_len(@_)) {
+ if (wantarray) {
+ my ($max, $min);
+ if ($#{$row1} > $#{$row2}) {
+ ($max, $min) = ($#{$row1}, $#{$row2} + 1);
+ } else {
+ ($max, $min) = ($#{$row2}, $#{$row1} + 1);
+ }
+ return ($min .. $max);
+ } else {
+ return abs(@{$row1} - @{$row2});
+ }
+ }
+
+ my ($arr1, $arr2) = @_;
+
+ my @diffs = ();
+
+ foreach (0 .. $#{$arr1}) {
+ next if keys %{$self->Skip} && $self->Skip->{$_};
+
+ my ($val1, $val2) = ($arr1->[$_], $arr2->[$_]);
+ unless ($self->WhiteSpace) {
+ $val1 =~ s/\s+/ /g;
+ $val2 =~ s/\s+/ /g;
+ }
+
+ unless ($self->Case) {
+ $val1 = lc $val1;
+ $val2 = lc $val2;
+ }
+
+ push @diffs, $_ unless $val1 eq $val2;
+ }
+
+ return wantarray ? @diffs : scalar @diffs;
+}
+
+=head2 perm \@ARR1, \@ARR2
+
+Check to see if one array is a permutation of the other (i.e. contains
+the same set of elements, but in a different order).
+
+We do this by sorting the arrays and passing references to the assorted
+versions to simple_compare. There are also some small changes to
+simple_compare as it should ignore the Skip hash if we are called from
+perm.
+
+=cut
+
+sub perm {
+ my $self = shift;
+
+ return $self->simple_compare([sort @{$_[0]}], [sort @{$_[1]}]);
+}
+
+#
+# Attempt to be clever with object attributes.
+# Each object attribute is always accessed using an access method.
+# None of these access methods exist in the object code.
+# If an unknown method is called then the AUTOLOAD method is called
+# in its place with the same parameters and the variable $AUTOLOAD
+# set to the name of the unknown method.
+#
+# In this function we work out which method has been called and
+# simulate it by returning the correct attribute value (and setting
+# it to a new value if the method was passed a new value to use).
+#
+# We're also a little cleverer than that as we create a new method on
+# the fly so that the next time we call the missing method it has
+# magically sprung into existance, thereby avoiding the overhead of
+# calling AUTOLOAD more than once for each method called.
+#
+sub AUTOLOAD {
+ no strict 'refs';
+ my ($self, $val) = @_;
+ my ($name) = $AUTOLOAD =~ m/.*::(\w*)/;
+
+ *{$AUTOLOAD} = sub { return @_ > 1 ?
+ $_[0]->{$name} = $_[1] :
+ $_[0]->{$name}};
+
+ return defined $val ? $self->{$name} = $val : $self->{$name};
+}
+
+#
+# One (small) downside of the AUTOLOAD trick, is that we need to
+# explicitly define a DESTROY method to prevent Perl from passing
+# those calls to AUTOLOAD. In this case we don't need to do anything.
+#
+sub DESTROY { }
+
+1;
+__END__
+
+=head1 AUTHOR
+
+Dave Cross <dave at mag-sol.com>
+
+=head1 SEE ALSO
+
+perl(1).
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000-2005, Magnum Solutions Ltd. All Rights Reserved.
+
+This script is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+#
+# $Log: Compare.pm,v $
+# Revision 1.13 2005/09/21 09:23:40 dave
+# Documentation fix
+#
+# Revision 1.12 2005/03/01 09:05:33 dave
+# Changes to pass Pod::Coverage tests (and, hence, increase kwalitee)
+#
+# Revision 1.11 2004/10/23 08:11:32 dave
+# Improved test coverage
+#
+# Revision 1.10 2004/10/22 20:32:48 dave
+# Improved docs for full comparison
+#
+# Revision 1.9 2003/09/19 09:37:40 dave
+# Bring CVS version into line with old file
+#
+# Revision 1.1 2003/09/19 09:34:43 dave
+# Bit of an overhaul
+#
+# Revision 1.7 2002/03/29 17:45:09 dave
+# Test version
+#
+# Revision 1.6 2002/01/09 11:41:52 dave
+# Small cleanups
+#
+# Revision 1.5 2001/12/09 19:31:47 dave
+# Cleanup.
+#
+# Revision 1.4 2001/06/04 20:47:01 dave
+# RCS Import
+#
+# Revision 1.3 2001/02/26 13:34:41 dave
+# Added case insensitivity.
+#
+# Revision 1.2 2000/06/04 17:43:14 dave
+# Renamed 'manifest' and 'readme' to 'MANIFEST' and 'README'.
+# Added header info.
+#
+# Revision 1.1.1.1 2000/06/04 17:40:19 dave
+# CVS import
+#
+# Revision 0.2 00/05/13 14:23:48 14:23:48 dave (Dave Cross)
+# Added 'perm' method.
+# Revision 0.1 00/04/25 13:33:55 13:33:55 dave (Dave Cross)
+# Initial version.
+#
Added: branches/upstream/libarray-compare-perl/current/t/pod.t
URL: http://svn.debian.org/wsvn/branches/upstream/libarray-compare-perl/current/t/pod.t?rev=10095&op=file
==============================================================================
--- branches/upstream/libarray-compare-perl/current/t/pod.t (added)
+++ branches/upstream/libarray-compare-perl/current/t/pod.t Sat Dec 1 11:49:49 2007
@@ -1,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
Added: branches/upstream/libarray-compare-perl/current/t/pod_coverage.t
URL: http://svn.debian.org/wsvn/branches/upstream/libarray-compare-perl/current/t/pod_coverage.t?rev=10095&op=file
==============================================================================
--- branches/upstream/libarray-compare-perl/current/t/pod_coverage.t (added)
+++ branches/upstream/libarray-compare-perl/current/t/pod_coverage.t Sat Dec 1 11:49:49 2007
@@ -1,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod::Coverage 1.00";
+plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
Added: branches/upstream/libarray-compare-perl/current/t/test.t
URL: http://svn.debian.org/wsvn/branches/upstream/libarray-compare-perl/current/t/test.t?rev=10095&op=file
==============================================================================
--- branches/upstream/libarray-compare-perl/current/t/test.t (added)
+++ branches/upstream/libarray-compare-perl/current/t/test.t Sat Dec 1 11:49:49 2007
@@ -1,0 +1,136 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+use Test::More tests => 30;
+
+use_ok('Array::Compare');
+
+my $comp = Array::Compare->new;
+
+my @A = qw/0 1 2 3 4 5 6 7 8/;
+my @B = qw/0 1 2 3 4 5 X 7 8/;
+my @C = @A;
+
+my %skip1 = (6 => 1);
+my %skip2 = (5 => 1);
+my %skip3 = (6 => 0);
+
+# Compare two different arrays - should fail
+ok(not $comp->compare(\@A, \@B));
+
+# Compare two different arrays but ignore differing column - should succeed
+$comp->Skip(\%skip1);
+ok($comp->compare(\@A, \@B));
+
+# compare two different arrays but ignore non-differing column - should fail
+$comp->Skip(\%skip2);
+ok(not $comp->compare(\@A, \@B));
+
+# Compare two different arrays but ignore differing column (badly)
+# - should fail as skip value is 0
+$comp->Skip(\%skip3);
+ok(not $comp->compare(\@A, \@B));
+
+# Change separator and compare two identical arrays - should succeed
+$comp->Sep('|');
+ok($comp->compare(\@A, \@C));
+
+# These tests should generate fatal errors - hence the evals
+
+# Compare a number with an array
+eval { print $comp->compare(1, \@A) };
+ok($@);
+
+# Compare an array with a number
+eval { print $comp->compare(\@A, 1) };
+ok($@);
+
+# Call compare with only one argument
+eval { print $comp->compare(\@A) };
+ok($@);
+
+# Switch to full comparison
+$comp->DefFull(1);
+ok($comp->DefFull);
+$comp->Skip({});
+
+# @A and @B differ in column 6
+# Array context
+my @diffs = $comp->compare(\@A, \@B);
+ok(scalar @diffs == 1 && $diffs[0] == 6);
+
+# Scalar context
+my $diffs = $comp->compare(\@A, \@B);
+ok($diffs);
+
+# @A and @B differ in column 6 (which we ignore)
+$comp->Skip(\%skip1);
+# Array context
+ at diffs = $comp->compare(\@A, \@B);
+ok(not @diffs);
+
+# Scalar context
+$diffs = $comp->compare(\@A, \@B);
+ok(not $diffs);
+
+# @A and @C are the same
+# Array context
+ at diffs = $comp->compare(\@A, \@C);
+ok(not @diffs);
+
+# Scalar context
+$diffs = $comp->compare(\@A, \@C);
+ok(not $diffs);
+
+# Test arrays of differing length
+my @D = (0 .. 5);
+my @E = (0 .. 10);
+
+$comp->DefFull(0);
+ok( not $comp->compare(\@D, \@E));
+
+$comp->DefFull(1);
+ at diffs = $comp->compare(\@D, \@E);
+ok(@diffs == 5);
+
+ at diffs = $comp->compare(\@E, \@D);
+ok(@diffs == 5);
+
+$diffs = $comp->compare(\@D, \@E);
+ok($diffs == 5);
+
+# Test Perms
+my @F = (1 .. 5);
+my @G = qw(5 4 3 2 1);
+my @H = qw(3 4 1 2 5);
+my @I = qw(4 3 6 5 2);
+
+ok($comp->perm(\@F, \@G));
+ok($comp->perm(\@F, \@H));
+ok(not $comp->perm(\@F, \@I));
+
+my @J = ('array with', 'white space');
+my @K = ('array with', 'white space');
+ok($comp->compare(\@J, \@K));
+
+# Turn off whitespace
+$comp->WhiteSpace(0);
+ok(not $comp->compare(\@J, \@K));
+
+$comp->DefFull(0);
+ok($comp->compare(\@J, \@K));
+
+# Turn on whitespace
+$comp->WhiteSpace(1);
+ok(not $comp->compare(\@J, \@K));
+
+my @L = qw(ArRay WiTh DiFfErEnT cAsEs);
+my @M = qw(aRrAY wItH dIfFeReNt CaSeS);
+ok(not $comp->compare(\@L, \@M));
+
+# Turn of case sensitivity
+$comp->Case(0);
+ok($comp->compare(\@L, \@M));
+
+$comp->DefFull(1);
+ok(not $comp->compare(\@L, \@M));
More information about the Pkg-perl-cvs-commits
mailing list