# vim: set ts=2 sts=2 sw=2 expandtab smarttab:
# Check that the XML output is correct.
# Also checks that tabs aren't tampered with.
use strict;
use warnings;
use Test::More;
use lib 't/lib';
use TVC_Test;
use IO::File;
use Path::Class qw( file );
my $NS = 'http://ns.laxan.com/text-vimcolor/1';
my %SYNTYPES = map { $_ => 1 } qw(
Comment Constant Identifier Statement Preproc
Type Special Underlined Error Todo
);
my @EXPECTED_PERL_SYN = qw(
Comment
Statement Identifier
Statement Constant Statement
Statement Constant Identifier Constant
Constant Special Constant
);
# vim will guess that string input is 'conf'
my @EXPECTED_NOFT_SYN = qw(
Comment
Constant
Constant
);
eval " use XML::Parser ";
if ($@) {
plan skip_all => 'XML::Parser module required for these tests.';
exit 0;
}
else {
plan tests => 12;
}
# Syntax color a Perl program, and check the XML output for well-formedness
# and validity. The tests are run with and without a root element in the
# output, and with both filename and string as input.
my $filename = file(qw( t data has_tabs.pl ))->stringify;
my $file = IO::File->new($filename, 'r')
or die "error opening file '$filename': $!";
my $data = do { local $/; <$file> };
# The value of these tests is not vim's filetype detection, so set it
# explicitly for portability across vim versions - rwstauner 2012-03-17
my $syntax = Text::VimColor->new(
file => $filename,
filetype => 'perl',
);
my $syntax_noroot = Text::VimColor->new(
file => $filename, xml_root_element => 0,
filetype => 'perl',
);
my $syntax_str = Text::VimColor->new(
string => $data,
filetype => 'conf',
);
my $syntax_str_noroot = Text::VimColor->new(
string => $data, xml_root_element => 0,
filetype => 'conf',
);
my %syntax = (
'no root element, filename input' => $syntax_noroot,
'no root element, string input' => $syntax_str_noroot,
'root element, filename input' => $syntax,
'root element, string input' => $syntax_str,
);
# These are filled in by the handler subs below.
my $text;
my $root_elem_count;
my $inside_element;
my @syntax_types;
my $parser = XML::Parser->new(
Handlers => {
Start => \&handle_start,
End => \&handle_end,
Char => \&handle_text,
Default => \&handle_default,
},
);
foreach my $test_type (sort keys %syntax) {
#diag("Doing XML tests for configuration '$test_type'.");
my $syn = $syntax{$test_type};
my $xml = $syn->xml;
# The ones without root elements need to be faked.
if ($test_type =~ /no root/) {
$xml = "<syn:syntax xmlns:syn='$NS'>$xml</syn:syntax>";
}
# Reset globals.
# These get modified by the Handler subs in the next call to $parser->parse.
$text = '';
$root_elem_count = 0;
$inside_element = 0;
@syntax_types = ();
$parser->parse($xml);
is($text, $data,
"check that text from XML output matches original");
is($root_elem_count, 1,
"there should only be one root element");
my $expected = ($test_type =~ /string/)
# Only expected to find string literals and comments.
? \@EXPECTED_NOFT_SYN
: \@EXPECTED_PERL_SYN;
is_deeply($expected, \@syntax_types,
"syntax types marked in the right order for '$test_type'")
or diag explain { exp => $expected, got => \@syntax_types };
}
sub handle_text
{
my ($expat, $s) = @_;
$text .= $s;
}
sub handle_start
{
my ($expat, $element, %attr) = @_;
$element =~ /^syn:(.*)\z/
or fail("element <$element> has wrong prefix"), return;
$element = $1;
fail("element <syn:$element> shouldn't be nested in something")
if $inside_element;
if ($element eq 'syntax') {
++$root_elem_count;
fail("namespace declaration missing from root element")
unless $attr{'xmlns:syn'};
fail("wrong namespace declaration in root element")
unless $attr{'xmlns:syn'} eq $NS;
}
else {
$inside_element = 1;
fail("bad element <syn:$element>")
if !$SYNTYPES{$element};
fail("element <syn:$element> shouldn't have any attributes")
if keys %attr;
# HACK: ignore more than a single line of comments at the beginning
# of the file (which might be added dynamically during build).
# can be removed if this gets merged (or we stop using Prepender):
# https://github.com/jquelin/dist-zilla-plugin-prepender/pull/1
return if @syntax_types == 1 && $element eq 'Comment';
push @syntax_types, $element;
}
}
sub handle_end
{
my ($expat, $element) = @_;
$element =~ /^syn:(.*)\z/
or fail("element <$element> has wrong prefix"), return;
$element = $1;
$inside_element = 0;
if ($element ne 'syntax' && !$SYNTYPES{$element}) {
fail("bad element <syn:$element>");
return;
}
}
sub handle_default
{
my ($expat, $s) = @_;
return unless $s =~ /\S/;
die "unexpected XML event for text '$s'\n";
}