Re: Test::MockObject 0.03

[Tatsuhiko Miyagawa]

At Sun, 28 Apr 2002 01:06:18 -0700,
chromatic wrote:

> I've written a module to make it easier to do very strict unit testing.  It
> lets you fake an existing interface somewhat more easily.  For example, if
> you're testing a web app, you can mock up CGI.pm instead of having to specify
> query information manually.

Seems interesting. But I prefer a direct way to define Mock classes
manually in a test code like:

  package Mock::CGI;
  sub param {
      my($self, $name) = @_;
      return $self->{$name};
  }

  package main;
  my $q = bless {}, 'Mock::CGI';
  my $app = WebApp->new($q);
  $app->run;

It's not so irresistable to me. And doing so gives me a flexibility.
Well I believe you'll convert me with your future article (on
perl.com?) ;)

Here's a patch 

* pass tests in 5.005_03
* can() should return subref instead of just 1


-- 
Tatsuhiko Miyagawa <[EMAIL PROTECTED]>


diff -ruN Test-MockObject-0.03/lib/Test/MockObject.pm 
Test-MockObject-0.03.patch/lib/Test/MockObject.pm
--- Test-MockObject-0.03/lib/Test/MockObject.pm Sun Apr 28 17:46:24 2002
+++ Test-MockObject-0.03.patch/lib/Test/MockObject.pm   Sun Apr 28 17:47:02 2002
@@ -15,6 +15,7 @@
 
 sub add {
        my ($self, $name, $sub) = @_;
+       $sub ||= sub {};
        $self->{_subs}{$name} = $sub;
 }
 
@@ -47,7 +48,7 @@
        my ($self, $sub) = @_;
 
        # mockmethods are special cases, class methods are handled directly
-       return 1 if (ref $self and exists $self->{_subs}{$sub});
+       return $self->{_subs}{$sub} if (ref $self and exists $self->{_subs}{$sub});
        return UNIVERSAL::can(@_);
 }
 
@@ -103,7 +104,7 @@
        return if $sub eq 'DESTROY';
 
        if (exists $self->{_subs}{$sub}) {
-               push @{ $self->{_calls} }, [ $sub, \@_ ];
+               push @{ $self->{_calls} }, [ $sub, [ @_ ] ];
                goto &{ $self->{_subs}{$sub} };
        }
        return;
diff -ruN Test-MockObject-0.03/t/base.t Test-MockObject-0.03.patch/t/base.t
--- Test-MockObject-0.03/t/base.t       Sun Apr 28 16:50:14 2002
+++ Test-MockObject-0.03.patch/t/base.t Sun Apr 28 17:43:28 2002
@@ -74,7 +74,7 @@
 
 can_ok( 'Test::MockObject', 'call_pos' );
 $mock->foo(1, 2, 3);
-$mock->bar([ foo ]);
+$mock->bar([ 'foo' ]);
 $mock->baz($mock, 88);
 is( $mock->call_pos(1), 'foo', 
        'call_pos() should report name of sub called by position' );