On Fri, Sep 28, 2001 at 11:10:24AM -0000, [EMAIL PROTECTED] wrote: > stas 01/09/28 04:10:24 > > Modified: perl-framework/Apache-Test/lib/Apache TestUtil.pm > Log: > - t_cmp now can compare and dump as a string *any* parseable > datastructures.
And this would make it also possible to compare subroutines for exactitude !
Not sure if it's really usefull, but here it is...
/home/gozer/sources/mod_perl2/deps/perl/bin/perl build/cvsdiff
Index: Apache-Test/lib/Apache/TestUtil.pm
===================================================================
RCS file:
/home/anoncvs/httpd-test-cvs/perl-framework/Apache-Test/lib/Apache/TestUtil.pm,v
retrieving revision 1.6
diff -u -I'$Id' -I'$Revision' -r1.6 TestUtil.pm
--- Apache-Test/lib/Apache/TestUtil.pm 2001/09/28 11:10:24 1.6
+++ Apache-Test/lib/Apache/TestUtil.pm 2001/09/28 11:56:21
@@ -14,6 +14,7 @@
our %CLEAN = ();
use constant HAS_DUMPER => eval { require Data::Dumper; };
+use constant HAS_DEPARSE => eval { require B::Deparse; };
use constant INDENT => 4;
sub t_cmp {
@@ -76,8 +77,19 @@
if (HAS_DUMPER) {
local $Data::Dumper::Terse = 1;
$Data::Dumper::Terse = $Data::Dumper::Terse; # warn
- my $data = Data::Dumper::Dumper(@_);
+
+ my $data;
+ foreach my $item (@_) {
+ if (HAS_DEPARSE and ref($item) and ( ref($item) eq 'CODE' )) {
+ my $dp = B::Deparse->new("-p", "-sC");
+ $data .= $dp->coderef2text($item);
+ }
+ else {
+ $data .= Data::Dumper::Dumper($item);
+ }
$data =~ s/\n$//; # \n is handled by the caller
+ }
+
return $data;
}
else {
> Revision Changes Path
> 1.6 +100 -11
> httpd-test/perl-framework/Apache-Test/lib/Apache/TestUtil.pm
>
> Index: TestUtil.pm
> ===================================================================
> RCS file:
> /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestUtil.pm,v
> retrieving revision 1.5
> retrieving revision 1.6
> diff -u -r1.5 -r1.6
> --- TestUtil.pm 2001/09/27 14:34:48 1.5
> +++ TestUtil.pm 2001/09/28 11:10:24 1.6
> @@ -13,18 +13,18 @@
>
> our %CLEAN = ();
>
> +use constant HAS_DUMPER => eval { require Data::Dumper; };
> +use constant INDENT => 4;
> +
> sub t_cmp {
> - my ($expected, $received, $comment) = @_;
> - print "testing : $comment\n" if defined $comment;
> - print "expected: " . (defined $expected ? $expected : "undef") . "\n";
> - print "received: " . (defined $received ? $received : "undef") . "\n";
> - if (defined $expected && defined $received) {
> - return $expected eq $received;
> - }
> - else {
> - # undef == undef! a valid test
> - return (defined $expected || defined $received) ? 0 : 1;
> - }
> + die join(":", (caller)[1..2]) .
> + ' usage: $res = t_cmp($expected, $received, [$comment])'
> + if @_ < 2 || @_ > 3;
> +
> + print "testing : ", pop ,"\n" if @_ == 3;
> + print "expected: ", struct_as_string(0, $_[0]), "\n";
> + print "received: ", struct_as_string(0, $_[1]), "\n";
> + return is_equal(@_);
> }
>
> sub t_write_file {
> @@ -59,6 +59,86 @@
> File::Path::rmtree((@_ > 1 ? [EMAIL PROTECTED] : $_[0]), 0, 1);
> }
>
> +# $string = struct_as_string($indent_level, $var);
> +#
> +# return any nested datastructure via Data::Dumper or ala Data::Dumper
> +# as a string. undef() is a valid arg.
> +#
> +# $indent_level should be 0 (used for nice indentation during
> +# recursive datastructure traversal)
> +sub struct_as_string{
> + return "???" unless @_ == 2;
> + my $level = shift;
> + return "undef" unless defined $_[0];
> + my $pad = ' ' x (($level + 1) * INDENT);
> + my $spad = ' ' x ($level * INDENT);
> +
> + if (HAS_DUMPER) {
> + local $Data::Dumper::Terse = 1;
> + $Data::Dumper::Terse = $Data::Dumper::Terse; # warn
> + my $data = Data::Dumper::Dumper(@_);
> + $data =~ s/\n$//; # \n is handled by the caller
> + return $data;
> + }
> + else {
> + if (ref($_[0]) eq 'ARRAY') {
> + my @data = ();
> + for my $i (0..$#{ $_[0] }) {
> + push @data,
> + struct_as_string($level+1, $_[0]->[$i]);
> + }
> + return join "\n", "[", map({"$pad$_,"} @data), "$spad\]";
> + } elsif ( ref($_[0])eq 'HASH') {
> + my @data = ();
> + for my $key (keys %{ $_[0] }) {
> + push @data,
> + "$key => " .
> + struct_as_string($level+1, $_[0]->{$key});
> + }
> + return join "\n", "{", map({"$pad$_,"} @data), "$spad\}";
> + } else {
> + return $_[0];
> + }
> + }
> +}
> +
> +# compare any two datastructures (must pass references for non-scalars)
> +# undef()'s are valid args
> +sub is_equal {
> + my ($a, $b) = @_;
> + return 0 unless @_ == 2;
> +
> + if (defined $a && defined $b) {
> + my $ref_a = ref $a;
> + my $ref_b = ref $b;
> + if (!$ref_a && !$ref_b) {
> + return $a eq $b;
> + }
> + elsif ($ref_a eq 'ARRAY' && $ref_b eq 'ARRAY') {
> + return 0 unless @$a == @$b;
> + for my $i (0..$#$a) {
> + is_equal($a->[$i], $b->[$i]) || return 0;
> + }
> + }
> + elsif ($ref_a eq 'HASH' && $ref_b eq 'HASH') {
> + return 0 unless (keys %$a) == (keys %$b);
> + for my $key (sort keys %$a) {
> + return 0 unless exists $b->{$key};
> + is_equal($a->{$key}, $b->{$key}) || return 0;
> + }
> + }
> + else {
> + # try to compare the references
> + return $a eq $b;
> + }
> + }
> + else {
> + # undef == undef! a valid test
> + return (defined $a || defined $b) ? 0 : 1;
> + }
> + return 1;
> +}
> +
> END{
>
> # remove files that were created via this package
> @@ -136,6 +216,15 @@
> 1 == t_cmp(undef, undef, "undef == undef?");
>
> is true.
> +
> +You can compare any two data-structures with t_cmp(). Just make sure
> +that if you pass non-scalars, you have to pass their references. The
> +datastructures can be deeply nested. For example you can compare:
> +
> + t_cmp({1 => [2..3,{5..8}], 4 => [5..6]},
> + {1 => [2..3,{5..8}], 4 => [5..6]},
> + "hash of array of hashes");
> +
>
> =item t_write_file()
>
>
>
>
--
Philippe M. Chiasson <[EMAIL PROTECTED]>
Extropia's Resident System Guru
http://www.eXtropia.com/
Being an adult isn't about being grown up--it's about
realizing you need to grow up.
-- Larry Wall
perl -e '$$=\${gozer};{$_=unpack(P26,pack(L,$$));/^Just Another Perl
Hacker!\n$/&&print||$$++&&redo}'
pgpxPLl9qXJQH.pgp
Description: PGP signature
