mock a method on a single object

[Belebele]

How can I mock a method on a _single_ object (as opposed to mocking
the method on all the objects of a class)? Consider:

package Foo;
{
sub new {
my $class = shift;
return bless {}, $class;
}

sub bar { print "bar\n" }
}


my ($a_foo, $another_foo) = (new Foo(), new Foo());
sub print_something { print "something\n" }
*Foo::bar = *print_something; # I would like to change the behavior
for only $a_foo, but not for $another_foo
$a_foo->bar(); # print_something
$another_foo->bar(); # print_something

Thanks

 

[Willem]

Belebele wrote:
) How can I mock a method on a _single_ object (as opposed to mocking
) the method on all the objects of a class)? Consider:

I'm not sure what you mean by 'mocking', but if it means what I think it
means, I would think that Perl calls that 'blessing' ?

) my ($a_foo, $another_foo) = (new Foo(), new Foo());
) sub print_something { print "something\n" }
) *Foo::bar = *print_something; # I would like to change the behavior
) for only $a_foo, but not for $another_foo
) $a_foo->bar(); # print_something
) $another_foo->bar(); # print_something

Perhaps something like:

bless $a_foo, 'Foo::barbaz';

package Foo::barbaz
our @ISA = 'Foo::bar';
sub print_something { print "something\n" }

would do the trick ?

Although I'm still not entirely sure what you intend to do.


SaSW, Willem
--
Disclaimer: I am in no way responsible for any of the statements
made in the above text. For all I know I might be
drugged or something..
No I'm not paranoid. You all think I'm paranoid, don't you !
#EOT

 

[Peter Scott]

How can I mock a method on a _single_ object (as opposed to mocking the
method on all the objects of a class)? Consider:

package Foo;
{
sub new {
my $class = shift;
return bless {}, $class;
}

sub bar { print "bar\n" }
}


my ($a_foo, $another_foo) = (new Foo(), new Foo()); sub print_something
{ print "something\n" } *Foo::bar = *print_something; # I would like to
change the behavior for only $a_foo, but not for $another_foo
$a_foo->bar(); # print_something
$another_foo->bar(); # print_something

$ cat foo
#!/usr/local/bin/perl
use strict;
use warnings;
use 5.10.0;

package Foo;
sub bar { say "bar" }
sub new { bless {}, shift }

package main;
use Test::MockObject::Extends;

my $x = Foo->new;
$x = Test::MockObject::Extends->new( $x );
$x->mock( bar => sub { say "mocked" } );
my $y = Foo->new;
$x->bar;
$y->bar;

$ ./foo
mocked
bar