123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301 |
- #!/usr/bin/env perl
- use strict;
- use warnings;
- use 5.010;
- use autodie;
- use File::Basename;
- use File::Spec::Functions;
- sub read_in_file {
- my $in_file = $_[0];
- # Will contain lines before first STARTTEST
- # as Lua comments.
- my @description_lines = ();
- # Will contain alternating blocks of lines of textual input
- # (text between ENDTEST and EOF/next STARTTEST) and test commands
- # (commands between STARTTEST and ENDTEST) as Lua code.
- my @test_body_lines = ();
- # Will contain current command block, i.e. lines
- # between STARTTEST and ENDTEST.
- my @command_lines = ();
- # Will contain current input block, i.e. lines
- # between ENDTEST and STARTTEST.
- my @input_lines = ();
- open my $in_file_handle, '<', $in_file;
- use constant EMIT_DESCRIPTION => 0;
- use constant EMIT_COMMAND => 1;
- use constant EMIT_INPUT => 2;
- # Push lines from current input and
- # command blocks into @test_body_lines
- # in the correct order.
- sub end_input {
- my $input_lines = $_[0];
- my $command_lines = $_[1];
- my $test_body_lines = $_[2];
- # If there are input lines, wrap with an `insert`
- # command and add before the previous command block.
- if (@{$input_lines}) {
- my $last_input_line = pop @{$input_lines};
- unshift @{$command_lines}, '';
- unshift @{$command_lines}, $last_input_line . ']=])';
- unshift @{$command_lines}, @{$input_lines};
- unshift @{$command_lines}, "insert([=[";
- @{$input_lines} = ();
- }
- # Output remaining command lines.
- push @{$test_body_lines}, @{$command_lines};
- @{$command_lines} = ();
- }
- sub format_comment {
- # Handle empty comments.
- if (/^$/) {
- return '';
- }
- # Capitalize first character and emit as Lua comment.
- my $comment = '-- ' . ucfirst $_;
- # Add trailing dot if not already there.
- $comment .= '.' unless $comment =~ /\.$/;
- return $comment;
- }
- my %states = (
- # Add test description to @description_lines.
- EMIT_DESCRIPTION() => sub {
- if (/^STARTTEST/) {
- return EMIT_COMMAND;
- }
- # If not an empty line, emit as Lua comment.
- if (!/^$/) {
- # Remove modeline
- s/vim:.*set f\w+=vim//g;
- # Remove trailing ":"
- s/\s*:\s*$//g;
- push @description_lines, '-- ' . $_;
- }
- return EMIT_DESCRIPTION;
- },
- # Add test commands to @command_lines.
- EMIT_COMMAND() => sub {
- if (/^ENDTEST/) {
- return EMIT_INPUT;
- }
- # If line starts with ':"', emit a comment.
- if (/^:"/) {
- # Remove Vim comment prefix.
- s/^:"\s*//;
- push @command_lines, format_comment $_;
- return EMIT_COMMAND;
- }
- # Extract possible inline comment.
- if (/^[^"]*"[^"]*$/) {
- # Remove command part and prepended whitespace.
- s/^(.*?)\s*"\s*//;
- push @command_lines, format_comment $_;
- # Set implicit variable to command without comment.
- $_ = $1;
- }
- # Only continue if remaining command is not empty.
- if (!/^:?\s*$/) {
- # Replace terminal escape characters with <esc>.
- s/\e/<esc>/g;
- my $startstr = "'";
- my $endstr = "'";
- # If line contains single quotes or backslashes, use double
- # square brackets to wrap string.
- if (/'/ || /\\/) {
- # If the line contains a closing square bracket,
- # wrap it with [=[...]=].
- if (/\]/) {
- $startstr = '[=[';
- $endstr = ']=]';
- } else {
- $startstr = '[[';
- $endstr = ']]';
- }
- }
- # Emit 'feed' if not a search ('/') or ex (':') command.
- if (!/^\// && !/^:/) {
- # If command does not end with <esc>, insert trailing <cr>.
- my $command = 'feed(' . $startstr . $_;
- $command .= '<cr>' unless /<esc>$/;
- $command .= $endstr . ')';
- push @command_lines, $command;
- } else {
- # Remove prepending ':'.
- s/^://;
- push @command_lines, 'execute(' . $startstr . $_ . $endstr . ')';
- }
- }
- return EMIT_COMMAND;
- },
- # Add input to @input_lines.
- EMIT_INPUT() => sub {
- if (/^STARTTEST/) {
- end_input \@input_lines, \@command_lines, \@test_body_lines;
- return EMIT_COMMAND;
- }
- # Skip initial lines if they are empty.
- if (@input_lines or !/^$/) {
- push @input_lines, ' ' . $_;
- }
- return EMIT_INPUT;
- },
- );
- my $state = EMIT_DESCRIPTION;
- while (<$in_file_handle>) {
- # Remove trailing newline character and process line.
- chomp;
- $state = $states{$state}->($_);
- }
- # If not all lines have been processed yet,
- # do it now.
- end_input \@input_lines, \@command_lines, \@test_body_lines;
- close $in_file_handle;
- return (\@description_lines, \@test_body_lines);
- }
- sub read_ok_file {
- my $ok_file = $_[0];
- my @assertions = ();
- if (-f $ok_file) {
- push @assertions, '';
- push @assertions, "-- Assert buffer contents.";
- push @assertions, "expect([=[";
- open my $ok_file_handle, '<', $ok_file;
- while (<$ok_file_handle>) {
- # Remove trailing newline character and process line.
- chomp;
- push @assertions, ' ' . $_;
- }
- close $ok_file_handle;
- $assertions[-1] .= "]=])";
- }
- return \@assertions;
- }
- my $legacy_testfile = $ARGV[0];
- my $out_dir = $ARGV[1];
- if ($#ARGV != 1) {
- say "Convert a legacy Vim test to a Neovim lua spec.";
- say '';
- say "Usage: $0 legacy-testfile output-directory";
- say '';
- say "legacy-testfile: Path to .in or .ok file.";
- say "output-directory: Directory where Lua spec will be saved to.";
- say '';
- say "Note: Only works reliably for fairly simple tests.";
- say " Manual adjustments to generated spec files are required.";
- exit 1;
- }
- my @legacy_suffixes = ('.in', '.ok');
- my ($base_name, $base_path, $suffix) = fileparse($legacy_testfile, @legacy_suffixes);
- my $in_file = catfile($base_path, $base_name . '.in');
- my $ok_file = catfile($base_path, $base_name . '.ok');
- # Remove leading 'test'.
- my $test_name = $base_name;
- $test_name =~ s/^test_?//;
- my $spec_file = do {
- if ($test_name =~ /^([0-9]+)/) {
- catfile($out_dir, sprintf('%03d', $1) . '_spec.lua')
- } else {
- catfile($out_dir, $test_name . '_spec.lua')
- }
- };
- if (! -f $in_file) {
- say "Test input file $in_file not found.";
- exit 2;
- }
- if (! -d $out_dir) {
- say "Output directory $out_dir does not exist.";
- exit 3;
- }
- if (-f $spec_file) {
- say "Output file $spec_file already exists.";
- print "Overwrite (Y/n)? ";
- my $input = <STDIN>;
- chomp($input);
- unless ($input =~ /^y|Y/) {
- say "Aborting.";
- exit 4;
- }
- }
- # Read .in and .ok files.
- my ($description_lines, $test_body_lines) = read_in_file $in_file;
- my $assertion_lines = read_ok_file $ok_file;
- # Append assertions to test body.
- push @{$test_body_lines}, @{$assertion_lines} if @{$assertion_lines};
- # Write spec file.
- open my $spec_file_handle, ">", $spec_file;
- print $spec_file_handle <<"EOS";
- @{[join "\n", @{$description_lines}]}
- local helpers = require('test.functional.helpers')
- local feed, insert, source = helpers.feed, helpers.insert, helpers.source
- local clear, execute, expect = helpers.clear, helpers.execute, helpers.expect
- describe('$test_name', function()
- before_each(clear)
- it('is working', function()
- @{[join "\n", map { /^$/ ? '' : ' ' . $_ } @{$test_body_lines}]}
- end)
- end)
- EOS
- close $spec_file_handle;
- say "Written to $spec_file."
|