httpd-test-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From "Philippe M . Chiasson" <go...@cpan.org>
Subject Re: cvs commit: httpd-test/perl-framework/Apache-Test/lib/Apache TestUtil.pm
Date Fri, 28 Sep 2001 11:57:22 GMT
On Fri, Sep 28, 2001 at 11:10:24AM -0000, stas@apache.org 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 ? \@_ : $_[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  <gozer@cpan.org>
  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}'

Mime
View raw message