Last week, in "Monkey-patching Benchmark.pm to auto-correct custom controls", we covered how to monkey-patch Benchmark.pm into giving us the results we wanted, and saw that one alternative method was to wrap the module instead.

This week, we investigate how to do this, and see what unpleasant surprises lie in wait when wrapping a procedural module.

First of all, let's look at the code for this week, then we'll analyse what it's doing.

package Benchmark::CustomControl;

use Benchmark ();

our $Control_Sub = sub { };
our $Control_Str = '';

sub timethese
{
    my ( $duration, $benchmarks, $style ) = @_;

    my $results = Benchmark::timethese( $duration, $benchmarks, $style );

    foreach my $name ( keys( %{$benchmarks} ) )
    {
        my ( $control, $iterations, $control_result );

        $control = ( ref( $benchmarks->{ $name } ) eq 'CODE' ) ?
            $Control_Sub : $Control_Str;

        $iterations = $results->{ $name }->[ 5 ];

        $control_result = Benchmark::timeit( $iterations, $control );
        $control_result->[ 5 ] = 0;

        $results->{ $name } = Benchmark::timediff(
            $results->{ $name },
            $control_result,
            );
    }

    return( $results );
}

1;

What we're doing here is creating a module called Benchmark::CustomControl, within that module we've created a version of timethese() that calls the standard Benchmark.pm version of timethese(), and then massages the returned results by subtracting the time taken to run the control function for the same number of iterations as each benchmark.

This is almost equivalent to the procedure we used in last week's article, the two main differences being:

• The timings of the control function happen in a block after all benchmarks are run, as opposed to immediately after each individual benchmark. This could conceivably result in a less relevant timing of the control function, but isn't likely to have an effect in practice.

• We're not replacing the hard-coded Benchmark.pm control function, so it's being applied to both the benchmark timing and the timing of our own control function. These two applications should cancel out but, because every timing is subject to error, it's an additional two sources of error in running the benchmark. That said, if that minor level of error is noticeable, you really ought to be running your benchmarks for longer than you currently are.

With those considerations safely dismissed we can say we've got a timethese() that compensates for a custom control.

Unfortunately for us, we don't actually want to use timethese() directly; what we were using last week, and want to continue using, is cmpthese().

Here's where we hit one of the pitfalls of wrapping a procedural module - we've got a shiny new version of timethese() that does what we want, but there's no way of telling the original cmpthese() to use our timethese() instead of the original.

So, we have to write a wrapped version of cmpthese() as well.

sub cmpthese
{
    my ($results, $style);

    # $count can be a blessed object.
    if ( ref $_[0] eq 'HASH' ) {
        ($results, $style) = @_;
    }
    else {
        my($count, $code) = @_[0,1];
        $style = $_[2] if defined $_[2];

        die <<'USAGE'
usage: cmpthese($count, { Name1 => 'code1', ... });        or
       cmpthese($count, { Name1 => sub { code1 }, ... });  or
       cmpthese($result, $style);
USAGE
            unless ref $code eq 'HASH';

        $results = timethese($count, $code, ($style || "none"));
    }

    return( Benchmark::cmpthese( $results, $style ) );
}

We have a break of luck here, in that the design of cmpthese() lets you pass in the results of a previous timethese() run.

This allows us to fudge things by intercepting calls that would have automatically run the original timethese() and instead run our timethese() and then pass the results of that call on to the original cmpthese() as if they were "previously run" results.

We've lifted almost all the code for this function from the Benchmark.pm original, with a slight tweak to how the usage message is written.

If we'd been unlucky, we'd have had to copy almost the entire of the original cmpthese(), effectively forking a copy of the original code, this would have meant for a higher level of maintainence as we'd need to watch changes to the upstream Benchmark.pm code and copy those changes too if we wanted to benefit from them.

With that sort of cut-n-pastism kept to a minimum we can move on.

If we bundle this all together with our benchmarks from last week, we get:

#!/usr/bin/perl -wT

use warnings;
use strict;

sub setup
{
    #  We're pretending here that we're doing something vital
    #  to setting up the benchmark, in reality we're just wasting
    #  as much time as for benchmark ONE to do its "real work".
    for( my $i = 0; $i < 100_000; $i++ )
    {
    }
}

my %h = (
    ONE => sub { setup(); for( my $i = 0; $i < 100_000; $i++ ) { } },
    TWO => sub { setup(); for( my $i = 0; $i < 200_000; $i++ ) { } },
    );

print "Testing with default control.\n";
{
    local $Benchmark::CustomControl::Control_Sub = sub { };
    Benchmark::CustomControl::cmpthese( -5, \%h );
}

print "\nTesting with our custom control.\n";
{
    local $Benchmark::CustomControl::Control_Sub = sub { setup(); };
    Benchmark::CustomControl::cmpthese( -5, \%h );
}

package Benchmark::CustomControl;

use Benchmark ();

our $Control_Sub = sub { };
our $Control_Str = '';

sub timethese
{
    my ( $duration, $benchmarks, $style ) = @_;

    my $results = Benchmark::timethese( $duration, $benchmarks, $style );

    foreach my $name ( keys( %{$benchmarks} ) )
    {
        my ( $control, $iterations, $control_result );

        $control = ( ref( $benchmarks->{ $name } ) eq 'CODE' ) ?
            $Control_Sub : $Control_Str;

        $iterations = $results->{ $name }->[ 5 ];

        $control_result = Benchmark::timeit( $iterations, $control );
        $control_result->[ 5 ] = 0;

        $results->{ $name } = Benchmark::timediff(
            $results->{ $name },
            $control_result,
            );
    }

    return( $results );
}

sub cmpthese
{
    my ($results, $style);

    # $count can be a blessed object.
    if ( ref $_[0] eq 'HASH' ) {
        ($results, $style) = @_;
    }
    else {
        my($count, $code) = @_[0,1];
        $style = $_[2] if defined $_[2];

        die <<'USAGE'
usage: cmpthese($count, { Name1 => 'code1', ... });        or
       cmpthese($count, { Name1 => sub { code1 }, ... });  or
       cmpthese($result, $style);
USAGE
            unless ref $code eq 'HASH';

        $results = timethese($count, $code, ($style || "none"));
    }

    return( Benchmark::cmpthese( $results, $style ) );
}

1;

We're putting the wrapped module within our script for convenience, but in normal practice we'd put it into a Benchmark/CustomControl.pm file as a "proper" module. (Along with all the usual Exporter.pm @EXPORT_OK goodies to make it easier to use.)

If we run the script we get the following:

Testing with default control.
      Rate  TWO  ONE
TWO 20.2/s   -- -33%
ONE 30.3/s  50%   --

Testing with our custom control.
      Rate  TWO  ONE
TWO 30.1/s   -- -50%
ONE 59.8/s  99%   --

This is, as we'd hope, strikingly similar to the results from last week.

So, what have we learned this week?

• To wrap a module we create a new module and call the functions in that module rather than the original.

• For each function we want to change the behaviour of, we need to produce a wrapped version.

• If the module we're wrapping is a procedural module then, for each function that we want to use that relies on the behaviour of a wrapped function, we need to wrap that function and any intervening functions too.

The final point there is the real weakness of wrapping a procedural module, if the code you're wrapping is deep within the original module, you may well end up replicating most of the rest of the module's code rather than just the bit you actually want to behave differently.

This is why, despite all the dangers, the monkey-patching in the previous article becomes a tempting alternative: it allows you to change only the the function you want to modify.