diff --git a/.travis.yml b/.travis.yml index 289fd8b1..b02f1c6c 100644 --- a/.travis.yml +++ b/.travis.yml @@ -2,7 +2,7 @@ language: perl install: - sudo apt-get install vim - cpanm --notest Test::Differences Text::VimColor IO::Pty Test::Deep Parallel::ForkManager JSON Path::Tiny Test::SharedFork Test::LongString - - git fetch origin p5-corpus:origin/p5-corpus + - git fetch origin p5-corpus-ng:origin/p5-corpus-ng - vim --version script: - make test diff --git a/build-corpus.pl b/build-corpus.pl index 6d38c67f..545d244f 100755 --- a/build-corpus.pl +++ b/build-corpus.pl @@ -123,7 +123,7 @@ sub create_tree { my $json = JSON->new->utf8->canonical; -my $iter = get_blob_iterator('origin/p5-corpus', 'corpus'); +my $iter = get_blob_iterator('origin/p5-corpus-ng', 'corpus'); my $tree = {}; while(my ( $filename, $contents ) = $iter->()) { @@ -133,26 +133,26 @@ sub create_tree { print { $source } $contents; close $source; - my $html = $color->color_file($source->filename); + my $marked = $color->markup_file($source->filename); my @folds = $fold->_get_folds($source->filename); - my $html_filename = $filename; - $html_filename =~ s{\Acorpus/}{}; - $html_filename .= '.html'; + my $marked_filename = $filename; + $marked_filename =~ s{\Acorpus/}{}; + $marked_filename .= '.json'; my $folds_filename = $filename; $folds_filename =~ s{\Acorpus/}{}; $folds_filename .= '-folds.json'; - insert_into_tree($tree, $html_filename, $html); + insert_into_tree($tree, $marked_filename, $json->encode($marked)); insert_into_tree($tree, $folds_filename, $json->encode(\@folds)); } $tree = create_tree($tree); -my $corpus_tree = find_git_object('origin/p5-corpus', 'corpus'); +my $corpus_tree = find_git_object('origin/p5-corpus-ng', 'corpus'); -$tree = two_way_pipe('git', 'mktree', "040000 tree $tree\tcorpus_html\n040000 tree $corpus_tree\tcorpus\n"); +$tree = two_way_pipe('git', 'mktree', "040000 tree $tree\tcorpus_marked\n040000 tree $corpus_tree\tcorpus\n"); chomp $tree; open my $pipe, '-|', 'git', 'commit-tree', '-m', 'Update Perl 5 corpus', $tree; @@ -160,5 +160,5 @@ sub create_tree { close $pipe; chomp $commit; -system 'git', 'update-ref', 'refs/heads/p5-corpus', $commit; -system 'git', 'push', 'origin', '--force', 'p5-corpus:p5-corpus'; +system 'git', 'update-ref', 'refs/heads/p5-corpus-ng', $commit; +system 'git', 'push', 'origin', '--force', 'p5-corpus-ng:p5-corpus-ng'; diff --git a/t/06_corpus.t b/t/06_corpus.t index 5b9e831f..b02663cf 100644 --- a/t/06_corpus.t +++ b/t/06_corpus.t @@ -10,12 +10,253 @@ use Local::VimFolds; use Local::Utils; use File::Temp; +use JSON qw(decode_json); +use List::Util qw(min max); use Parallel::ForkManager; use Path::Tiny; use Test::Differences; use Test::More; use Test::SharedFork; -use Test::LongString; # for is_string() + +# XXX these values are currently taken from peaksea.vim +# what about terminal attributes like bold? +my %fg_color_map = ( + Identifier => 219, + Statement => 153, + Type => 153, + Constant => 110, + Comment => 186, + Number => 179, + PreProc => 84, + Special => 179, + Todo => 88, + + '' => 253, +); + +my %bg_color_map = ( + '' => '', +); + +$fg_color_map{'String'} = $fg_color_map{'Constant'}; +$fg_color_map{'Float'} = $fg_color_map{'Number'}; +$fg_color_map{'Conditional'} = $fg_color_map{'Statement'}; +$fg_color_map{'Operator'} = $fg_color_map{'Statement'}; +$fg_color_map{'Keyword'} = $fg_color_map{'Statement'}; +$fg_color_map{'Function'} = $fg_color_map{'Statement'}; +$fg_color_map{'Label'} = $fg_color_map{'Statement'}; +$fg_color_map{'Repeat'} = $fg_color_map{'Statement'}; + +my $GRAY = "\e[38;5;243m"; +my $RESET = "\e[0m"; + +sub lines_from_marked { + my ($marked) = @_; + my @lines = (); + my $current_line = []; + + foreach my $elem (@$marked) { + my ( $group, $text ) = @$elem; + + if($text =~ /\n/) { + while(my ( $prefix, $postfix ) = $text =~ /^(.*?)\n(.*)$/s) { + if($prefix ne '') { + push @$current_line, [ $group, $prefix ]; + } + push @lines, $current_line; + $current_line = []; + $text = $postfix; + } + + if($text ne '') { + push @$current_line, [ $group, $text ]; + } + } else { + push @$current_line, $elem; + } + } + if(@$current_line) { + push @lines, $current_line; + } + + return @lines; +} + +# XXX not Unicode-aware! naïve implementation for now (sanity check the underlying text) +sub split_glyphs { + my ($s) = @_; + return $s =~ /(.)/g; +} + +sub build_color_map { + my ($marked) = @_; + my @map; + + for my $line (lines_from_marked($marked)) { + my $map_line = []; + push @map, $map_line; + + for my $grouping (@$line) { + my ( $group, $text ) = @$grouping; + + for my $glyph (split_glyphs($text)) { + push @$map_line, $group; + } + } + } + + return \@map; +} + +sub build_glyph_map { + my ($marked) = @_; + my @map; + + for my $line (lines_from_marked($marked)) { + my $map_line = []; + push @map, $map_line; + + for my $grouping (@$line) { + my ( $group, $text ) = @$grouping; + + for my $glyph (split_glyphs($text)) { + push @$map_line, $glyph; + } + } + } + + return \@map; +} + +sub is_visible { + my ($glyph) = @_; + return $glyph !~ /\pZ/; # XXX is this good enough? +} + +sub find_differently_colored_lines { + my ($a_lines, $b_lines) = @_; + my @differences; + + my $glyph_map = build_glyph_map($a_lines); + my $before_map = build_color_map($a_lines); + my $after_map = build_color_map($b_lines); + + # XXX assert that dimensions for maps match + + for my $lindex (0..$#$before_map) { + my $line_no = $lindex + 1; + + my $before_line = $before_map->[$lindex]; + my $after_line = $after_map->[$lindex]; + + for my $cindex (0..$#$before_line) { + my $column_no = $cindex + 1; + + my $glyph = $glyph_map->[$lindex][$cindex]; + my $before_group = $before_line->[$cindex]; + my $after_group = $after_line->[$cindex]; + + my $before_fg_color = $fg_color_map{$before_group} or die "no fg color $before_group"; + my $after_fg_color = $fg_color_map{$after_group} or die "no fg color $after_group"; + my $before_bg_color = $bg_color_map{$before_group} || $bg_color_map{''}; + my $after_bg_color = $bg_color_map{$after_group} || $bg_color_map{''}; + + if($before_bg_color ne $after_bg_color) { + push @differences, [ $lindex, $cindex ]; + } + if(is_visible($glyph) && $before_fg_color ne $after_fg_color) { + push @differences, [ $lindex, $cindex ]; + } + } + } + + return \@differences; +} + +sub get_color_code { + my ($group) = @_; + + my $fg_color_code = $fg_color_map{$group}; + if($fg_color_code ne '') { + $fg_color_code = "\e[38;5;${fg_color_code}m"; + } + + my $bg_color_code = $bg_color_map{$group} || ''; + if($bg_color_code ne '') { + $bg_color_code = "\e[38;5;${bg_color_code}m"; + } + + return $fg_color_code . $bg_color_code; +} + +sub color_line { + my ($line) = @_; + my @pieces; + for my $chunk (@$line) { + my ( $group, $text ) = @$chunk; + my $color_code = get_color_code($group); + push @pieces, $color_code, $text, $RESET; + } + return join('', @pieces); +} + +sub extract_text { + my ($line) = @_; + return join('', map { $_->[1] } @$line); +} + +# XXX only print the first N differences? +# visually indicate the differing columns (via underline, reverse video, etc)? +# handle terminals too narrow to show results +sub diag_differences { + my ($before_lines, $after_lines, $diffs) = @_; + my $num_context = 3; + my @print_me = map { '' } 0..$#$before_lines; + + for my $diff (@$diffs) { + my ( $line_no, undef ) = @$diff; + for my $line (max(0, $line_no - 3)..min($#$before_lines, $line_no + 3)) { + $print_me[$line] = 'context'; + } + } + + for my $diff (@$diffs) { + my ( $line_no, undef ) = @$diff; + $print_me[$line_no] = 'diff'; + } + + my $max_line_length = 0; + + for my $lindex (0..$#print_me) { + if($print_me[$lindex]) { + $max_line_length = max($max_line_length, length(extract_text($before_lines->[$lindex]))); + } + } + + for my $lindex (0..$#print_me) { + my $line_no = $lindex + 1; + my $padding; + + if($print_me[$lindex]) { + $padding = ' ' x ($max_line_length - length(extract_text($before_lines->[$lindex]))); + } + + if($print_me[$lindex] eq 'context') { + diag $GRAY, sprintf('%4d', $line_no), + ' ', + extract_text($before_lines->[$lindex]) . $padding, + ' | ', + extract_text($after_lines->[$lindex]), + $RESET; + } elsif($print_me[$lindex] eq 'diff') { + diag sprintf('%4d', $line_no), + ' ', + color_line($before_lines->[$lindex]) . $padding, + ' | ', + color_line($after_lines->[$lindex]); + } + } +} my $color = Local::VimColor->new( language => 'perl', @@ -31,40 +272,46 @@ my $fold = Local::VimFolds->new( ); my $pm = Parallel::ForkManager->new(16); -my $iter = get_blob_iterator('origin/p5-corpus', 'corpus'); -my $is_passing = 1; +my $iter = get_blob_iterator('origin/p5-corpus-ng', 'corpus'); $pm->run_on_finish(sub { - my ( undef, $status ) = @_; + my ( undef, $status, undef, undef, undef, $data ) = @_; + + my ( $filename, $expected_marked, $got_marked, $expected_folds, $got_folds ) = @$data; - $is_passing &&= ($status == 0); + # XXX calculate differences in child? + my $differences = find_differently_colored_lines($expected_marked, $got_marked); + ok(!@$differences, "colors for file '$filename' match"); + if(@$differences) { + diag_differences([ lines_from_marked($expected_marked) ], + [ lines_from_marked($got_marked) ], $differences); + } + eq_or_diff($got_folds, $expected_folds, "folds for file '$filename' match"); }); while(my ( $filename, $content ) = $iter->()) { next unless $filename =~ /(?:pm|pl)\z/; next if $pm->start; - my $expected_html = get_html_output_for($filename); - my @expected_folds = get_folds_for($filename); + my $marks_filename = ($filename =~ s{\Acorpus}{corpus_marked}r) . '.json'; + my $expected_marked = decode_json(get_corpus_contents($marks_filename)); + my @expected_folds = get_folds_for($filename); my $source = File::Temp->new; print { $source } $content; close $source; - my $got_html = $color->color_file($source->filename); + my $got_marked = $color->markup_file($source->filename); my @got_folds = $fold->_get_folds($source->filename); - is_string($got_html, $expected_html, "colors for file '$filename' match"); - eq_or_diff(\@got_folds, \@expected_folds, "folds for file '$filename' match"); - - $pm->finish(Test::More->builder->is_passing ? 0 : 1); + $pm->finish(0, [ $filename, $expected_marked, $got_marked, \@expected_folds, \@got_folds ]); } $pm->wait_all_children; -unless($is_passing) { +unless(Test::More->builder->is_passing) { diag <<'END_DIAG'; -The corpus test failed! This means that among the files stored under corpus/ in the p5-corpus +The corpus test failed! This means that among the files stored under corpus/ in the p5-corpus-ng branch, the syntax highlighting and/or the folding has changed for one or more files. You need to let a vim-perl maintainer know about this! diff --git a/tools/Local/Utils.pm b/tools/Local/Utils.pm index fa7f2303..41de68ad 100644 --- a/tools/Local/Utils.pm +++ b/tools/Local/Utils.pm @@ -89,7 +89,7 @@ sub get_blob_iterator { sub get_corpus_contents { my ( $filename ) = @_; - open my $pipe, '-|', 'git', 'show', 'origin/p5-corpus:' . $filename; + open my $pipe, '-|', 'git', 'show', 'origin/p5-corpus-ng:' . $filename; my $content = do { local $/; <$pipe> @@ -98,19 +98,10 @@ sub get_corpus_contents { return $content; } -sub get_html_output_for { - my ( $filename ) = @_; - - $filename =~ s{\Acorpus/}{corpus_html/}; - $filename .= '.html'; - - return get_corpus_contents($filename); -} - sub get_folds_for { my ( $filename ) = @_; - $filename =~ s{\Acorpus/}{corpus_html/}; + $filename =~ s{\Acorpus/}{corpus_marked/}; $filename .= '-folds.json'; my $contents = get_corpus_contents($filename); @@ -118,6 +109,6 @@ sub get_folds_for { return @{ decode_json($contents) }; } -our @EXPORT = qw(get_blob_iterator get_corpus_contents get_html_output_for get_folds_for find_git_object); +our @EXPORT = qw(get_blob_iterator get_corpus_contents get_folds_for find_git_object); 1; diff --git a/tools/Local/VimColor.pm b/tools/Local/VimColor.pm index a7225bcb..f093e7a2 100644 --- a/tools/Local/VimColor.pm +++ b/tools/Local/VimColor.pm @@ -40,4 +40,10 @@ sub color_file { return $self->{'hilite'}->syntax_mark_file($filename)->html; } +sub markup_file { + my ( $self, $filename ) = @_; + + return $self->{'hilite'}->syntax_mark_file($filename)->marked; +} + 1;