Wrapper around vspec to support simple benchmarks

vbench

#!/usr/bin/env perl
# Usage: vbench [non_standard_runtimepaths ...] input_script [reference_output]
#
# 'vbench' is a wrapper around vspec that adds benchmarking capabilities.
#
# vbench runs a test script, just like vspec. When the test script follows the
# convention of outputting a time measurement alongside a successful test
# result, in the following format,
#
#       ok 1 - Test case outputs time measurement
#       # (0.234)
#
# then vbench understands the # line as a benchmark time measurement. vbench
# can compare these measurements with those from an earlier run, and show the
# difference +/- between runs.
#
# Example. (a) Run test script like vspec, (b) run and save reference
# measurements, (c) compare new measurements with reference measurements.
#
#       $ vbench ~/.vim/bundle/vspec t/string.vim
#       $ vbench ~/.vim/bundle/vspec t/string.vim > string_ref
#       $ vbench ~/.vim/bundle/vspec t/string.vim string_ref

use v5.14;

use Term::ANSIColor qw(:constants);
use strict;
use warnings;

my $okline = qr/^ok \d+ - (.*)$/;
my $timeline = qr/^# \((\d+.\d+)\)$/;
my @rtps;
my $inputscript;
my $refoutput;

# This is simple: if the last arg ends in '.vim' it's the test script.
if (@ARGV > 0 and $ARGV[-1] =~ /\.vim$/) {
    @rtps = @ARGV[0 .. $#ARGV-1];
    $inputscript = $ARGV[-1];
    $refoutput = '/dev/null';
}
elsif (@ARGV > 1 and $ARGV[-2] =~ /\.vim$/) {
    @rtps = @ARGV[0 .. $#ARGV-2];
    $inputscript = $ARGV[-2];
    $refoutput = $ARGV[-1];
}
else {
    say "Usage: $0 [non_standard_runtimepaths ...] input_script [reference_output]";
    exit 1;
}

my $cmd = "vspec " . (join ' ', @rtps) . " $inputscript";

# The pipe has the :crlf IO layer because vspec output may have line
# endings that look like CRLF line endings.
open my $vspec, '-|:crlf', $cmd or die "Can't start vspec";
open my $ref, '<', $refoutput or die "Can't open reference file";

sub get_reftimes {
    my %reftimes;
    my $key;
    for my $line (<$ref>) {
        given ($line) {
            when (/$okline/) { $key = $1 }
            when (defined $key and /$timeline/) {
                $reftimes{$key} = $1;
                $key = undef;
            }
            default { $key = undef }
        }
    }
    return %reftimes;
}

sub minus_string {
    my ($time, $reftime) = @_;
    return sprintf("-%.1f%% (%.3f)", (1.0 - $time/$reftime) * 100, $reftime);
}

sub plus_string {
    my ($time, $reftime) = @_;
    return sprintf("+%.1f%% (%.3f)", ($time/$reftime - 1.0) * 100, $reftime);
}

# main

my %reftimes = get_reftimes();
my $key;
while (my $line = <$vspec>) {
    chomp $line;
    if ($line =~ /$okline/) {
        $key = $1;
        say "$line";
    }
    elsif (defined $key and $line =~ /$timeline/ and defined $reftimes{$key}) {
        my $reftime = $reftimes{$key};
        my $tolerance = $reftime * 0.015;
        if ($reftime - $tolerance > $1) {
            say "$line ", GREEN, minus_string($1, $reftime), RESET;
        }
        elsif ($reftime + $tolerance < $1) {
            say "$line ", RED, plus_string($1, $reftime), RESET;
        }
        elsif ($reftime > $1) {
            say "$line ", YELLOW, minus_string($1, $reftime), RESET;
        }
        else {
            say "$line ", YELLOW, plus_string($1, $reftime), RESET;
        }
        $key = undef;
    }
    else {
        $key = undef;
        say "$line";
    }
}