#!/usr/bin/perl --
use Benchmark qw/ cmpthese /;
print "$]\n";
cmpthese(
    -3,
    {
        circumcised => sub {
            my $what = 'WWWA';
            $what =~ /AB.*Z/gc; # fail one
            $what .='DBBBABC';
            pos($what) = 8;
            $what =~ /AB.*Z/gc; # fail another
            return;
        },
        uncut => sub {
            my $what = 'WWWA';
            $what =~ /AB.*Z/gc; # fail one
            $what .='DBBBABC';
            $what =~ /AB.*Z/gc; # fail another
            return;
        },
    },
);

print "\n\n";


cmpthese(
    -3,
    {
        circumcised => sub {
            my $what = 'WWWA';
            $what =~ /AB.*Z/gc; # fail one
            $what .='DBBBABCZ';
            pos($what) = 8;
            $what =~ /AB.*Z/gc; # match one
            return;
        },
        uncut => sub {
            my $what = 'WWWA';
            $what =~ /AB.*Z/gc; # fail one
            $what .='DBBBABCZ';
            $what =~ /AB.*Z/gc; # match one
            return;
        },
    },
);
print "\n\n";

cmpthese(
    -3,
    {
        circumcised => sub {
            my $what = 'WWWA';
            $what =~ /AB.*Z/gc; # fail one
            $what .='DBBBABCZ';
            substr $what, 0, 8, '';
            $what =~ /AB.*Z/gc; # match one
            return;
        },
        uncut => sub {
            my $what = 'WWWA';
            $what =~ /AB.*Z/gc; # fail one
            $what .='DBBBABCZ';
            $what =~ /AB.*Z/gc; # match one
            return;
        },
    },
);
print "\n\n";
cmpthese(
    -3,
    {
        circumcised => sub {
            my $what = 'WWWA';
            $what =~ /AB.*Z/; # fail one
            $what .='DBBBABCZ';
            substr $what, 0, 8, '';
            $what =~ /AB.*Z/; # match one
            return;
        },
        uncut => sub {
            my $what = 'WWWA';
            $what =~ /AB.*Z/; # fail one
            $what .='DBBBABCZ';
            $what =~ /AB.*Z/; # match one
            return;
        },
    },
);
print "\n\n";
__END__
[download]

5.014001
                 Rate circumcised       uncut
circumcised  370001/s          --        -70%
uncut       1245010/s        236%          --


                Rate circumcised       uncut
circumcised 301014/s          --        -41%
uncut       506153/s         68%          --


                Rate circumcised       uncut
circumcised 398024/s          --        -19%
uncut       492750/s         24%          --


                Rate circumcised       uncut
circumcised 554597/s          --        -26%
uncut       749156/s         35%          --
[download]