You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
Kaleidoscope/testing/bin/ktest-to-cxx

630 lines
18 KiB

#!/usr/bin/perl
use warnings;
use strict;
use Getopt::Long;
use File::Spec;
use Data::Dumper;
my $text_filename = "";
my $cxx_filename = "";
my $verbose;
my $cxx_output = "";
my $depth = 0;
my $reports_expected = 0;
my @script_lines;
my $named_switches = {};
my $inside_test = 0;
my $stanza = 0;
my $test_class = 'GeneratedKTest';
GetOptions(
"cxx=s" => \$cxx_filename, # string
"ktest=s" => \$text_filename,
"verbose" => \$verbose
) # flag
or die("Error in command line arguments\n");
my $test;
if ( -f $text_filename ) {
load_from_text();
}
else {
die "Couldn't find $text_filename";
}
generate_test_file();
open( my $outfile, ">", $cxx_filename ) || die "Can't open output file $!";
print $outfile $cxx_output;
close($outfile);
exit(0);
sub load_from_text {
my @content = ();
open( my $text_fh, "<", $text_filename ) or die "Can't open file $!";
my $line_num = 0;
for my $line (<$text_fh>) {
my ( $key, $content, $comment, $error, $type );
$line_num++;
chomp $line;
my $raw_line = $line;
$raw_line =~ s/"/''/g;
$line =~ s/^\s+//;
$line =~ s/\s+$//;
if ( $line eq '' ) {
next;
}
if ( $line =~ /^(.*?)\s*#\s*(.*)$/ ) {
$line = $1;
$comment = $2;
}
if ( $line =~ /^(.*?)\s+(.*)\s*$/ ) {
$type = lc $1;
$content = $2;
}
else {
$type = lc $line;
}
my $dispatcher = {
version => sub {
my $version = shift;
if ( $version != 1 ) {
die "This parser only supports v1";
}
return undef;
},
name => sub {
my $name = shift;
$name =~ s/\s(\w)/uc($1)/eg;
return { test_name => $name };
},
todo => sub { my $content = shift; return { reason => $content }; },
end_todo => sub { return { 1 => 1 } },
keyswitch => sub {
my $content = shift;
if ( $content =~ /^(.*?)\s+(\d+)\s+(\d+)$/ ) {
my $switch = $1;
my $row = $2;
my $col = $3;
if ( exists $named_switches->{$switch} ) {
die "Attempted to redefine '$switch' on line $line_num";
}
else {
$named_switches->{$switch} = [ $row, $col ];
}
return undef;
}
},
press => sub {
my $content = shift;
unless ( defined $named_switches->{$content} ) {
die
"Attempt to press undefined switch $content on line $line_num";
}
return { switch => $content };
},
release => sub {
my $content = shift;
unless ( defined $named_switches->{$content} ) {
die
"Attempt to release undefined switch $content on line $line_num";
}
return { switch => $content };
},
expect => sub {
my $content = shift;
if ( $content =~ /^no keyboard-report/ ) {
return {
report_type => 'keyboard',
count => 0
};
}
if ( $content =~ /^keyboard-report\s+(.*)$/ ) {
my $report_data = $1;
my @keys = split( /,?\s+/, $report_data );
if ( $#keys == 0 && $keys[0] =~ /^empty$/i ) {
@keys = ();
}
return {
count => 1, # We expect one report here
report_type => 'keyboard',
keys => [@keys]
};
}
if ( $content =~ /^no mouse-report/ ) {
return {
report_type => 'mouse',
count => 0
};
}
if ( $content =~ /^mouse-report\s+(.*)$/ ) {
my $report_data = $1;
my @args = split( /,?\s+/, lc $report_data );
my $mouse_report_data = {};
$mouse_report_data->{buttons} = [];
$mouse_report_data->{x} = "0";
$mouse_report_data->{y} = "0";
$mouse_report_data->{v} = "0";
$mouse_report_data->{h} = "0";
if ( scalar(@args) == 1 && $args[0] =~ /^empty$/i ) {
@args = ();
}
for my $arg (@args) {
if ( $arg =~ /(\w+)=([\w\d\-\+]+)/ ) {
my $field = $1;
my $value = $2;
if ( $field =~ /button/ ) {
if ( $value =~ /^l/ ) {
$value = 'MouseReport::kButtonLeft';
}
elsif ( $value =~ /^r/ ) {
$value = 'MouseReport::kButtonRight';
}
elsif ( $value =~ /^m/ ) {
$value = 'MouseReport::kButtonMiddle';
}
elsif ( $value =~ /^n/ ) {
$value = 'MouseReport::kButtonNext';
}
elsif ( $value =~ /^p/ ) {
$value = 'MouseReport::kButtonPrev';
}
else {
die
"Couldn't parse mouse button value from $content at line $line_num";
}
push @{ $mouse_report_data->{buttons} }, $value;
}
elsif ( $field =~ /x/ ) {
$mouse_report_data->{x} = $value;
}
elsif ( $field =~ /y/ ) {
$mouse_report_data->{y} = $value;
}
elsif ( $field =~ /v/ ) {
$mouse_report_data->{v} = $value;
}
elsif ( $field =~ /h/ ) {
$mouse_report_data->{h} = $value;
}
else {
die "Don't know how parse $content at line $line_num";
}
}
else {
die "Don't know how parse $content at line $line_num";
}
}
return {
count => 1, # We expect one report here
report_type => 'mouse',
data => $mouse_report_data,
}
}
else {
die "Don't know how parse $content at line $line_num";
}
},
run => sub {
my $content = shift;
if ( $content =~ /^(\d+)\s*(\w*?)$/ ) {
my $count = $1;
my $unit = $2;
if ( $unit =~ /cycle/ ) {
return { cycles => $count };
}
elsif ( $unit =~ /milli|ms/ ) {
return { millis => $count };
}
else {
die
"Line $line_num: failed to parse a 'run' clause: $content";
}
}
else {
die
"Line $line_num: failed to parse a 'run' clause: $content";
}
},
delay => sub {
my $content = shift;
if ( $content =~ /^(\d+)\s*(\w*?)$/ ) {
my $count = $1;
my $unit = $2;
if ( $unit =~ /milli|ms/ ) {
return { millis => $count };
}
else {
die
"Line $line_num: failed to parse a 'delay' clause: $content";
}
}
else {
die
"Line $line_num: failed to parse a 'delay' clause: $content";
}
},
};
my $data;
if ( $type && exists $dispatcher->{$type} ) {
$data = $dispatcher->{$type}->($content);
# an empty return means "don't put it in the script
if ( !$data ) {
next;
}
}
push @content,
{
action => $type,
content => $content,
comment => $comment,
data => $data,
line_num => $line_num,
raw_line => $raw_line
};
}
close($text_fh);
@script_lines = @content;
}
sub generate_test_file {
generate_preface();
generate_key_addrs();
generate_script();
generate_postscript();
if ( $depth != 0 ) {
die "Unbalanced indentation: Depth is $depth";
}
}
sub generate_key_addrs {
cxx_section('Key Addresses');
for my $key ( keys %$named_switches ) {
cxx( "constexpr KeyAddr key_addr_$key {"
. $named_switches->{$key}->[0] . ", "
. $named_switches->{$key}->[1]
. "};" );
}
}
sub generate_start_new_test {
my $name = shift;
if ($inside_test) {
generate_end_test();
}
cxx( "TEST_F($test_class, " . $stanza++ . "_$name) {" );
$inside_test = $name;
indent();
cxx("ClearState(); // Clear any state from previous tests");
}
sub generate_start_todo_test_section {
if ($inside_test) {
outdent();
cxx("} // TEST_F");
cxx('');
cxx('');
cxx('');
}
cxx( "TEST_F($test_class, DISABLED_" . $stanza++ . "_$inside_test) {" );
indent();
}
sub generate_end_todo_test_section {
outdent();
cxx("} // DISABLED TEST_F");
if ($inside_test) {
cxx('');
cxx('');
cxx('');
cxx( "TEST_F($test_class, " . $stanza++ . "_$inside_test) {" );
indent();
}
}
sub generate_end_test {
generate_check_expected_reports();
outdent();
cxx("} // TEST_F");
cxx('');
cxx('');
cxx('');
$inside_test = 0;
}
sub generate_script {
cxx_section("Test script");
# Super evil hack from https://stackoverflow.com/a/48924764
# We should do this better, inside the core. But until we do
# I'd rather stick the macro in the code generator so nobody
# gets to use it from regular tests, boxing us in
cxx('#define GTEST_COUT std::cerr << "[ INFO ] "');
generate_start_new_test('KtestSourceFilename');
cxx(
"GTEST_COUT << \"test: @{[File::Spec->rel2abs( $text_filename ) ]}\" << std::endl;"
);
generate_end_test('');
$reports_expected = 0;
for my $entry (@script_lines) {
#cxx("std::cerr << \"".$entry->{raw_line}."\" << std::endl;");
if ( $entry->{comment} && ( !$entry->{action} ) ) {
cxx_comment( $entry->{comment} );
}
elsif ( my $action = $entry->{action} ) {
if ( $action eq 'name' ) {
generate_start_new_test( $entry->{data}->{test_name} );
}
elsif ( $action eq 'todo' ) {
generate_start_todo_test_section();
cxx(
"GTEST_COUT << \"TODO: @{[
$entry->{'data'}->{'reason'} || 'The author did not specify a reason'
]}\" << std::endl;"
);
if ( $entry->{comment} ) {
cxx_comment( $entry->{comment} );
}
}
elsif ( $action eq 'end_todo' ) {
if ( $entry->{comment} ) {
cxx_comment( $entry->{comment} );
}
generate_end_todo_test_section();
}
elsif ( !$inside_test && defined $action ) {
die
"Attempting to run an action '$action' when not inside a test section on line "
. $entry->{line_num} . "\n";
}
elsif ( $action eq 'press' ) { generate_press($entry) }
elsif ( $action eq 'release' ) { generate_release($entry); }
elsif ( $action eq 'run' ) { generate_run($entry) }
elsif ( $action eq 'delay' ) { generate_delay($entry) }
elsif ( $action eq 'expect' ) { generate_expect_report($entry); }
else {
die "$action unknown on line $entry->{line_num}";
}
}
}
if ($inside_test) {
generate_end_test();
}
}
sub generate_run {
my $action = shift;
if ( $action->{'comment'} ) {
cxx_comment( $action->{'comment'} );
}
if ( $action->{data}->{'cycles'} ) {
cxx( 'sim_.RunCycles(' . $action->{data}->{'cycles'} . ');' );
}
elsif ( $action->{data}->{'millis'} ) {
cxx( 'sim_.RunForMillis(' . $action->{data}->{'millis'} . ');' );
}
}
sub generate_delay {
my $action = shift;
if ( $action->{'comment'} ) {
cxx_comment( $action->{'comment'} );
}
if ( $action->{data}->{'millis'} ) {
cxx( 'delay(' . $action->{data}->{'millis'} . ');' );
}
}
sub generate_press {
my $e = shift;
# TODO handle multuple presses
cxx( "PressKey(key_addr_" . $e->{data}->{switch} . "); // ", $e->{comment} );
}
sub generate_release {
my $e = shift;
# TODO handle multiple releases
cxx( "ReleaseKey(key_addr_" . $e->{data}->{switch} . "); // ", $e->{comment} );
}
sub generate_expect_report {
my $report = shift;
if ( $report->{data}->{report_type} eq 'keyboard' ) {
generate_expect_keyboard_report($report);
}
elsif ( $report->{data}->{report_type} eq 'mouse' ) {
generate_expect_mouse_report($report);
}
else {
die
"Don't know how to handle expectaions of report types other than 'keyboard' and 'mouse' at line #"
. $report->{line_num} . "\n";
}
$reports_expected++;
}
sub generate_expect_keyboard_report {
my $report = shift;
if ( $report->{data}->{count} == 0 ) {
if ( $report->{comment} ) {
cxx_comment( $report->{comment} );
}
cxx_comment(
"We don't expect any report here, and have told the tests to check that"
);
return;
}
my $codes = join(
", ",
(
ref( $report->{data}->{keys} )
? @{ $report->{data}->{keys} }
: ( $report->{data}->{keys} )
)
);
cxx( "ExpectKeyboardReport(Keycodes{$codes}, \""
. ( $report->{comment} || 'No explanatory comment specified' )
. "\");" );
cxx("");
}
sub generate_expect_mouse_report {
my $report = shift;
if ( $report->{data}->{count} == 0 ) {
if ( $report->{comment} ) {
cxx_comment( $report->{comment} );
}
cxx_comment(
"We don't expect any report here, and have told the tests to check that"
);
return;
}
my $buttons_code = "0";
my @buttons = ( ref( $report->{data}->{data}{buttons} )
? @{ $report->{data}->{data}{buttons} }
: ( $report->{data}->{data}{buttons} ) );
for my $button_value (@buttons) {
$buttons_code .= " | $button_value";
}
cxx("ExpectMouseReport($buttons_code, "
. $report->{data}{data}{x} . ", "
. $report->{data}{data}{y} . ", "
. $report->{data}{data}{v} . ", "
. $report->{data}{data}{h} . ", "
. "\""
. ( $report->{comment} || 'No explanatory comment specified' )
. "\");" );
cxx("");
}
sub generate_check_expected_reports {
cxx("");
cxx("LoadState();");
cxx("CheckReports();");
}
sub generate_preface {
my $preface = <<EOF;
#include "testing/setup-googletest.h"
#include "Kaleidoscope.h"
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// !! WARNING! This test file was automatically generated. !!
// !! It -will- be overwritten on on subsequent test runs. !!
// !! Do not edit it. You will be sad, when you lose all !!
// !! your changes. !!
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// Source file: @{[File::Spec->rel2abs( $text_filename ) ]}
SETUP_GOOGLETEST();
namespace kaleidoscope {
namespace testing {
namespace {
class @{[$test_class]} : public VirtualDeviceTest {};
EOF
for my $line ( split /\n/, $preface ) {
cxx($line);
}
}
sub generate_postscript {
my $postscript = <<EOF;
} // namespace
} // namespace testing
} // namespace kaleidoscope
EOF
for my $line ( split /\n/, $postscript ) {
cxx($line);
}
}
sub indent {
$depth += 2;
}
sub outdent {
$depth -= 2;
if ( $depth < 0 ) {
die "Tried to outdent beyond 0";
}
}
sub cxx_section {
my $line = shift;
cxx('');
cxx('');
cxx_comment($line);
cxx_comment( "=" x length($line) );
cxx('');
cxx('');
}
sub cxx_comment {
my $line = shift;
cxx( "// " . $line );
}
sub cxx {
my $line = shift;
my $comment = shift || '';
$cxx_output .= " " x $depth;
$cxx_output .= $line;
$cxx_output .= $comment if ($comment);
$cxx_output .= "\n";
if ($verbose) {
debug("$line");
}
}
sub debug {
my $msg = shift;
print STDERR ( " " x $depth ) . $msg . "\n";
}