r76926 - in /branches/upstream/libstruct-compare-perl: ./ current/ current/Changes current/Compare.pm current/MANIFEST current/Makefile.PL current/t/ current/t/core.t
fabreg-guest at users.alioth.debian.org
fabreg-guest at users.alioth.debian.org
Fri Jul 1 23:13:46 UTC 2011
Author: fabreg-guest
Date: Fri Jul 1 23:13:45 2011
New Revision: 76926
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=76926
Log:
[svn-inject] Installing original source of libstruct-compare-perl (1.0.1)
Added:
branches/upstream/libstruct-compare-perl/
branches/upstream/libstruct-compare-perl/current/
branches/upstream/libstruct-compare-perl/current/Changes
branches/upstream/libstruct-compare-perl/current/Compare.pm
branches/upstream/libstruct-compare-perl/current/MANIFEST
branches/upstream/libstruct-compare-perl/current/Makefile.PL
branches/upstream/libstruct-compare-perl/current/t/
branches/upstream/libstruct-compare-perl/current/t/core.t
Added: branches/upstream/libstruct-compare-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libstruct-compare-perl/current/Changes?rev=76926&op=file
==============================================================================
--- branches/upstream/libstruct-compare-perl/current/Changes (added)
+++ branches/upstream/libstruct-compare-perl/current/Changes Fri Jul 1 23:13:45 2011
@@ -1,0 +1,10 @@
+Revision history for Perl extension Struct::Compare.
+
+1.0.1 - 2001-03-09
+
+ Improved POD docs, added license, released.
+
+1.0.0 - 2001-01-17
+
+ Original version.
+
Added: branches/upstream/libstruct-compare-perl/current/Compare.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libstruct-compare-perl/current/Compare.pm?rev=76926&op=file
==============================================================================
--- branches/upstream/libstruct-compare-perl/current/Compare.pm (added)
+++ branches/upstream/libstruct-compare-perl/current/Compare.pm Fri Jul 1 23:13:45 2011
@@ -1,0 +1,158 @@
+package Struct::Compare;
+
+=head1 NAME
+
+Struct::Compare - Recursive diff for perl structures.
+
+=head1 SYNOPSIS
+
+ use Struct::Compare;
+ my $is_different = compare($ref1, $ref2);
+
+=head1 DESCRIPTION
+
+Compares two values of any type and structure and returns true if they
+are the same. It does a deep comparison of the structures, so a hash
+of a hash of a whatever will be compared correctly.
+
+This is especially useful for writing unit tests for your modules!
+
+=head1 PUBLIC FUNCTIONS
+
+=over 4
+
+=cut
+
+use strict;
+require Exporter;
+use vars qw($VERSION @ISA @EXPORT);
+use Carp qw(croak);
+
+ at ISA = qw(Exporter);
+ at EXPORT = qw(compare);
+
+$VERSION = '1.0.1';
+
+# TODO: document
+
+use constant FALSE=>0;
+use constant TRUE =>1;
+use constant DEBUG=>0;
+
+=item * $bool = compare($var1, $var2)
+
+Recursively compares $var1 to $var2, returning false if either
+structure is different than the other at any point. If both are
+undefined, it returns true as well, because that is considered equal.
+
+=cut
+
+sub compare {
+ my $x = shift;
+ my $y = shift;
+
+ if (@_) {
+ croak "Too many items sent to compare";
+ }
+
+ return FALSE if defined $x xor defined $y;
+ return TRUE if ! defined $x and ! defined $y;
+
+ my $a = ref $x ? $x : \$x;
+ my $b = ref $y ? $y : \$y;
+
+ print "\$a is a ", ref $a, "\n" if DEBUG;
+ print "\$b is a ", ref $b, "\n" if DEBUG;
+
+ return FALSE unless ref $a eq ref $b;
+
+ if (ref $a eq 'SCALAR') {
+ print "a = $$a, b = $$b\n" if DEBUG;
+ return $$a eq $$b;
+ }
+
+ if (ref $a eq 'HASH') {
+ my @keys = keys %{$a};
+ my $max = scalar(@keys);
+ return FALSE if $max != scalar(keys %{$b});
+ return TRUE if $max == 0;
+
+ # first just look to see if there are any keys not in the other;
+ my $found = 0;
+ foreach my $key (@keys) {
+ $found++ if exists $b->{$key};
+ }
+
+ return FALSE if $found != $max;
+
+ # now compare the values
+ foreach my $key (@keys) {
+ # WARN: recursion may get really deep.
+ return FALSE unless compare($a->{$key}, $b->{$key});
+ }
+
+ return TRUE;
+ }
+
+ if (ref $a eq 'ARRAY') {
+ my $max = scalar(@{$a});
+ return FALSE if $max != scalar(@{$b});
+ return TRUE if $max == 0;
+
+ for (my $i = 0; $i < $max; ++$i) {
+ # WARN: recursion may get really deep.
+ return FALSE unless compare($a->[$i], $b->[$i]);
+ }
+
+ return TRUE;
+ }
+
+ # FIX: doesn't deal with non-basic types... see if you can fake it.
+
+ return FALSE;
+}
+
+1;
+
+__END__
+
+=back
+
+=head1 BUGS/NEEDED ENHANCEMENTS
+
+=item * blessed references
+
+compare currently does not deal with blessed references. I need to
+look into how to deal with this.
+
+=head1 LICENSE
+
+(The MIT License)
+
+Copyright (c) 2001 Ryan Davis, Zen Spider Software
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+=head1 AUTHOR
+
+Ryan Davis <ryand-cmp at zenspider.com>
+Zen Spider Software <http://www.zenspider.com/ZSS/>
+
+=cut
Added: branches/upstream/libstruct-compare-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libstruct-compare-perl/current/MANIFEST?rev=76926&op=file
==============================================================================
--- branches/upstream/libstruct-compare-perl/current/MANIFEST (added)
+++ branches/upstream/libstruct-compare-perl/current/MANIFEST Fri Jul 1 23:13:45 2011
@@ -1,0 +1,5 @@
+Changes
+Compare.pm
+MANIFEST
+Makefile.PL
+t/core.t
Added: branches/upstream/libstruct-compare-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libstruct-compare-perl/current/Makefile.PL?rev=76926&op=file
==============================================================================
--- branches/upstream/libstruct-compare-perl/current/Makefile.PL (added)
+++ branches/upstream/libstruct-compare-perl/current/Makefile.PL Fri Jul 1 23:13:45 2011
@@ -1,0 +1,7 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'Struct::Compare',
+ 'VERSION_FROM' => 'Compare.pm', # finds $VERSION
+);
Added: branches/upstream/libstruct-compare-perl/current/t/core.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libstruct-compare-perl/current/t/core.t?rev=76926&op=file
==============================================================================
--- branches/upstream/libstruct-compare-perl/current/t/core.t (added)
+++ branches/upstream/libstruct-compare-perl/current/t/core.t Fri Jul 1 23:13:45 2011
@@ -1,0 +1,114 @@
+# -*- perl -*-
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..23\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Struct::Compare;
+$loaded = 1;
+print "ok 1\n";
+
+my $testnum = 2;
+
+sub assert($$) {
+ my $mesg = shift;
+ my $test = shift;
+
+ print "\n$mesg\n";
+ if ($test) {
+ print "ok $testnum\n";
+ } else {
+ print "not ok $testnum\n";
+ }
+
+ $testnum++;
+}
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+############################################################
+# Simple Scalars
+
+assert("Simple scalar diff must return true when two numbers are the same",
+ compare(1, 1));
+assert("Simple scalar diff must return true when two strings are the same",
+ compare("1", "1"));
+assert("Simple scalar diff must return false when two numbers differ",
+ ! compare(1, 2));
+assert("Simple scalar diff must return false when two strings differ",
+ ! compare("1", "12"));
+assert("Simple scalar diff must return false the LHS value is undef",
+ ! compare(undef, 1));
+assert("Simple scalar diff must return false the RHS value is undef",
+ ! compare(1, undef));
+
+############################################################
+# Array Refs:
+
+assert("Simple array refs must return true when they are both empty",
+ compare([], []));
+assert("Simple array refs must return false when they are differing sizes",
+ ! compare([1, 2, 3], [1, 2]));
+assert("Simple array refs must return false when they are differing order",
+ ! compare([1, 2, 3], [3, 2, 1]));
+assert("Simple array refs must return false when they are differing values",
+ ! compare([1, 2, 3], [3, 2, 0]));
+assert("Simple array refs must return true when they are the same",
+ compare([1, 2, 3], [1, 2, 3]));
+
+############################################################
+# Hash Refs:
+
+assert("Simple hash refs must return true when they are both empty",
+ compare({}, {}));
+assert("Simple hash refs must return false when they are differing sizes",
+ ! compare({'a' => 1}, {'a' => 1, 'b' => 2}));
+assert("Simple hash refs must return false when they are differing values",
+ ! compare({'a' => 1, 'b' => 2}, {'a' => 1, 'b' => 3}));
+assert("Simple hash refs must return true when they are the same",
+ compare({'a' => 1, 'b' => 2}, {'a' => 1, 'b' => 2}));
+
+############################################################
+# Complex(er) types:
+
+my $a = {'a' => [ 1, 2, [ 3 ], { 'b' => 4 } ],
+ 'c' => 42,
+ 'd' => { 'e' => { 'f' => [] } } };
+
+my $b = {'a' => [ 1, 2, [ 3 ], { 'b' => 4 } ],
+ 'c' => 42,
+ 'd' => { 'e' => { 'f' => [] } } };
+
+my $c = {'a' => [ 1, 2, [ 3 ], { 'b' => 4 } ],
+ 'c' => 42,
+ 'd' => { 'e' => { 'f' => [ "this is different" ] } } };
+
+assert("This is a quicky, I think it will work",
+ compare($a, $b));
+assert("This is a quicky, I think it will work",
+ compare($b, $a));
+assert("This is a quicky, I think it will work",
+ ! compare($a, $c));
+assert("This is a quicky, I think it will work",
+ ! compare($c, $a));
+
+############################################################
+# Differing types:
+assert("Simple scalar diff must return true if string and number are the same",
+ compare(1, "1"));
+assert("Empty hash and array refs must return false when they are both empty",
+ ! compare({}, []));
+
+############################################################
+# TEMPLATE: copy only
+assert("Array refs must return XXX when they are both empty",
+ compare([], []));
More information about the Pkg-perl-cvs-commits
mailing list