Add helper scripts for testing regressions

build-corpus.pl

@@ -0,0 +1,77 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use lib 'tools';
+
+use Local::MissingModule;
+use Local::VimColor;
+use Local::VimFolds;
+
+use File::Find;
+use File::Path qw(make_path);
+use File::Spec;
+use File::Slurp qw(write_file);
+use JSON qw(encode_json);
+use Parallel::ForkManager;
+use Term::ProgressBar;
+
+my $color = Local::VimColor->new(
+    language => 'perl',
+);
+
+my $fold = Local::VimFolds->new(
+    options => {
+        perl_fold                => 1,
+        perl_nofold_packages     => 1,
+        perl_fold_anonymous_subs => 1,
+    },
+    language => 'perl',
+);
+
+my @corpus_files;
+my @output_files;
+
+find({ wanted => sub {
+    return unless /[.](?:pm|pl)$/;
+
+    my $path = $File::Find::name;
+
+    push @corpus_files, $path;
+
+    my ( undef, $dir, $file ) = File::Spec->splitpath($path);
+    my @dirs = File::Spec->splitdir($dir);
+    $dirs[0] = 'corpus_html';
+    push @output_files, File::Spec->catfile(@dirs, $file . '.html');
+    make_path(File::Spec->catdir(@dirs), {
+        verbose => 1,
+    });
+}, no_chdir => 1}, 'corpus');
+
+# XXX don't allow building when dirty?
+write_file('corpus_html/revision', `git rev-parse HEAD`);
+
+my $p  = Term::ProgressBar->new({ count => scalar(@corpus_files) });
+my $pm = Parallel::ForkManager->new(16);
+
+for(my $i = 0; $i < @corpus_files; $i++) {
+    my $pid = $pm->start;
+    if($pid) {
+        $p->update($i);
+        next;
+    }
+
+    my $source      = $corpus_files[$i];
+    my $output      = $output_files[$i];
+    my $fold_output = $output_files[$i];
+
+    $fold_output =~ s/[.]html$/-folds.json/;
+
+    write_file($output, $color->color_file($source));
+
+    my @folds = $fold->_get_folds($source);
+
+    write_file($fold_output, encode_json(\@folds));
+
+    $pm->finish;
+}

verify-corpus.pl

@@ -0,0 +1,122 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw(say);
+use lib 'tools';
+
+use Local::MissingModule;
+use Local::VimColor;
+use Local::VimFolds;
+
+use File::Find;
+use File::Path qw(make_path);
+use File::Slurp qw(read_file);
+use File::Spec;
+use JSON qw(decode_json);
+use Parallel::ForkManager;
+use Text::VimColor;
+use Term::ProgressBar;
+
+sub cmp_folds {
+    my ( $got, $expected ) = @_;
+
+    return unless @$got == @$expected;
+
+    for(my $i = 0; $i < @$got; $i++) {
+        return unless $got->[$i]{'level'} == $expected->[$i]{'level'};
+        return unless $got->[$i]{'start'} == $expected->[$i]{'start'};
+        return unless $got->[$i]{'end'}   == $expected->[$i]{'end'};
+    }
+
+    return 1;
+}
+
+my $color = Local::VimColor->new(
+    language => 'perl',
+);
+
+my $fold = Local::VimFolds->new(
+    options => {
+        perl_fold                => 1,
+        perl_nofold_packages     => 1,
+        perl_fold_anonymous_subs => 1,
+    },
+    language => 'perl',
+);
+
+my $revision = read_file('corpus_html/revision', chomp => 1);
+my $pretty_revision = qx(git log -1 --pretty=format:%d $revision);
+chomp $pretty_revision;
+$pretty_revision =~ s/^\s+|\s+$//g;
+if($pretty_revision) {
+    $pretty_revision =~ s/^\(|\)$//g;
+} else {
+    $pretty_revision = $revision;
+}
+say STDERR "verifying against corpus built with $pretty_revision...";
+
+my @corpus_files;
+my @output_files;
+
+find({ wanted => sub {
+    return unless /[.](?:pm|pl)$/;
+
+    my $path = $File::Find::name;
+
+    push @corpus_files, $path;
+
+    my ( undef, $dir, $file ) = File::Spec->splitpath($path);
+    my @dirs = File::Spec->splitdir($dir);
+    $dirs[0] = 'corpus_html';
+    push @output_files, File::Spec->catfile(@dirs, $file . '.html');
+    make_path(File::Spec->catdir(@dirs), {
+        verbose => 1,
+    });
+}, no_chdir => 1}, 'corpus');
+
+my $pm   = Parallel::ForkManager->new(16);
+my $code = 0;
+$pm->run_on_finish(sub {
+    my ( undef, $exit ) = @_;
+
+    $code = 1 unless $exit == 0;
+});
+
+for(my $i = 0; $i < @corpus_files; $i++) {
+    my $pid = $pm->start;
+    if($pid) {
+        next;
+    }
+
+    my $source      = $corpus_files[$i];
+    my $output      = $output_files[$i];
+    my $fold_output = $output_files[$i];
+
+    $fold_output =~ s/[.]html$/-folds.json/;
+
+    my $got      = read_file($output);
+    my $expected = $color->color_file($source);
+
+    my $code = 0;
+    unless($got eq $expected) {
+        my @got_lines      = split /\n/, $got;
+        my @expected_lines = split /\n/, $expected;
+        say "colors: $source";
+        $code = 1;
+    }
+
+    my @got_folds      = $fold->_get_folds($source);
+    my $expected_folds = decode_json(read_file($fold_output));
+
+    unless(cmp_folds(\@got_folds, $expected_folds)) {
+        say "folds: $source";
+        $code = 1;
+    }
+
+    $pm->finish($code);
+}
+
+$pm->wait_all_children;
+
+exit($code);