#!/usr/bin/perl --
use Benchmark qw/ cmpthese /;
print "$]\n";

my $what1 = my $what2 = my $orig = 'LMNOPQRSTUVWYXZWWWA';
my $pos1 = 0;
cmpthese(
    -3,
    {
        circumcised => sub {
            $what1 =~ /AB.*Z/gc; # fail one
            $what1 .='DBBBABC';
            $pos1+=8;
            pos($what1) = $pos1;
            $what1 =~ /AB.*Z/gc; # fail another
            return;
        },
        uncut => sub {
            $what2 =~ /AB.*Z/gc; # fail one
            $what2 .='DBBBABC';
            $what2 =~ /AB.*Z/gc; # fail another
            return;
        },
    },
);

print "length circumcised(@{[length $what1 ]}) uncut(@{[ length $what2 ]})\n\n";


$what1 = $what2 = $orig;
$pos1 = 0;
cmpthese(
    -3,
    {
        circumcised => sub {
            $what1 =~ /AB.*Z/gc; # fail one
            $what1 .='DBBBABCZ';
            $pos1+=8;
            pos($what1) = $pos1;
            $what1 =~ /AB.*Z/gc; # match one
            return;
        },
        uncut => sub {
            $what2 =~ /AB.*Z/gc; # fail one
            $what2 .='DBBBABCZ';
            $what2 =~ /AB.*Z/gc; # match one
            return;
        },
    },
);
print "length circumcised(@{[length $what1 ]}) uncut(@{[ length $what2 ]})\n\n";

$what1 = $what2 = $orig;
cmpthese(
    -3,
    {
        circumcised => sub {
            $what1 =~ /AB.*Z/gc; # fail one
            $what1 .='DBBBABCZ';
            substr $what1, 0, 8, '';
            $what1 =~ /AB.*Z/gc; # match one
            return;
        },
        uncut => sub {
            $what2 =~ /AB.*Z/gc; # fail one
            $what2 .='DBBBABCZ';
            $what2 =~ /AB.*Z/gc; # match one
            return;
        },
    },
);
print "length circumcised(@{[length $what1 ]}) uncut(@{[ length $what2 ]})\n\n";

$what1 = $what2 = $orig;
cmpthese(
    -3,
    {
        circumcised => sub {
            $what1 =~ /AB.*Z/; # fail one
            $what1 .='DBBBABCZ';
            substr $what1, 0, 8, '';
            $what1 =~ /AB.*Z/; # match one
            return;
        },
        uncut => sub {
            $what2 =~ /AB.*Z/; # fail one
            $what2 .='DBBBABCZ';
            $what2 =~ /AB.*Z/; # match one
            return;
        },
    },
);
print "length circumcised(@{[length $what1 ]}) uncut(@{[ length $what2 ]})\n\n";
__END__
5.014001
                Rate       uncut circumcised
uncut         2305/s          --       -100%
circumcised 517638/s      22360%          --
length circumcised(13175874) uncut(219812)

                Rate       uncut circumcised
uncut         2843/s          --        -99%
circumcised 361434/s      12614%          --
length circumcised(10770163) uncut(396371)

                Rate       uncut circumcised
uncut         2855/s          --       -100%
circumcised 579256/s      20188%          --
length circumcised(19) uncut(395315)

                Rate       uncut circumcised
uncut         2176/s          --       -100%
circumcised 435567/s      19915%          --
length circumcised(19) uncut(235675)