Trw prototype around

Makefile.PL

@@ -21,7 +21,7 @@ my %WriteMakefileArgs = (
     "Carp" => 0,
     "Data::Dumper" => 0,
     "Exporter" => 0,
-    "Scalar::Util" => 0,
+    "Scalar::Util" => 1.13,   # Comes with 5.8.1. For set_prototype().
     "Term::Table" => "0.013",
     "Test2::API" => "1.302176",
     "Time::HiRes" => 0,

cpanfile

@@ -5,7 +5,7 @@ requires "B" => "0";
 requires "Carp" => "0";
 requires "Data::Dumper" => "0";
 requires "Exporter" => "0";
-requires "Scalar::Util" => "0";
+requires "Scalar::Util" => "1.13";
 requires "Term::Table" => "0.013";
 requires "Test2::API" => "1.302176";
 requires "Time::HiRes" => "0";

dist.ini

@@ -32,7 +32,7 @@ Term::Table   = 0.013
 B             = 0
 Carp          = 0
 Exporter      = 0
-Scalar::Util  = 0
+Scalar::Util  = 1.13
 Time::HiRes   = 0
 overload      = 0
 utf8          = 0

lib/Test2/Mock.pm

@@ -7,7 +7,7 @@ our $VERSION = '0.000160';
 use Carp qw/croak confess/;
 our @CARP_NOT = (__PACKAGE__);
 
-use Scalar::Util qw/weaken reftype blessed/;
+use Scalar::Util qw/weaken reftype blessed set_prototype/;
 use Test2::Util qw/pkg_to_file/;
 use Test2::Util::Stash qw/parse_symbol slot_to_sig get_symbol get_stash purge_symbol/;
 use Test2::Util::Sub qw/gen_accessor gen_reader gen_writer/;
@@ -223,15 +223,16 @@ sub before {
     my ($name, $sub) = @_;
     $self->_check();
     my $orig = $self->current($name);
-    $self->_inject({}, $name => sub { $sub->(@_); $orig->(@_) });
+    $self->_inject({}, $name => set_prototype(
+	sub { $sub->(@_); $orig->(@_) }, prototype $sub));
 }
 
 sub after {
     my $self = shift;
     my ($name, $sub) = @_;
     $self->_check();
     my $orig = $self->current($name);
-    $self->_inject({}, $name => sub {
+    $self->_inject({}, $name => set_prototype( sub {
         my @out;
 
         my $want = wantarray;
@@ -251,15 +252,16 @@ sub after {
         return @out    if $want;
         return $out[0] if defined $want;
         return;
-    });
+    }, prototype $sub));
 }
 
 sub around {
     my $self = shift;
     my ($name, $sub) = @_;
     $self->_check();
     my $orig = $self->current($name);
-    $self->_inject({}, $name => sub { $sub->($orig, @_) });
+    $self->_inject({}, $name => set_prototype(
+	sub { $sub->($orig, @_) }, prototype $sub));
 }
 
 sub add {

t/modules/Mock.t

@@ -932,4 +932,44 @@ subtest tracking => sub {
     is(My::Track->foo, 'foo', "Original restored");
 };
 
+subtest prototypes => sub {
+
+    sub foo_022 ($) { $_[0] }	# Because this is test 22.
+
+    # NOTE that we make use of the prototype in the following code.
+
+    is( foo_022 'bar', 'bar', 'foo_022 returns its argument' );
+
+    my $one = Test2::Mock->new( class => __PACKAGE__ );
+
+    my $warning = warnings {
+	$one->before( foo_022 => sub ($) { warn "Before foo_022( '$_[0]' )" } );
+	is( foo_022 'baz', 'baz', 'foo_022 still returns its argument' );
+    };
+    is $warning, [
+	match qr/\ABefore foo_022\( 'baz' \)/,
+    ], 'Got warning from before() hook';
+    $one->reset_all();
+
+    $warning = warnings {
+	is( foo_022 'foo', 'foo', 'foo_022 persists in returning its argument' );
+    };
+    is $warning, [], 'No warnings after resetting mock';
+
+    $warning = warnings {
+	$one->after( foo_022 => sub ($) { warn "After foo_022( '$_[0]' )" } );
+	is( foo_022 'plugh', 'plugh', 'foo_022 steadfastly returns its argument' );
+    };
+    is $warning, [
+	match qr/\AAfter foo_022\( 'plugh' \)/,
+    ], 'Got warning from after() hook';
+    $one->reset_all();
+
+    $warning = warnings {
+	$one->around( foo_022 => sub ($) { return $_[0]->( $_[1] ) x 2 } );
+	is foo_022 '42', '4242', 'With around(), foo_022 now doubles its return';
+    };
+    is $warning, [], 'around() produced no warnings';
+};
+
 done_testing;