#!/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] }; } 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} || $report->{data}->{report_type} ne 'keyboard' ) { die "Don't know how to work with expectaions of reports other than 'keyboard' reports at line #" . $report->{line_num} . "\n"; } $reports_expected++; 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( "ExpectReport(Keycodes{$codes}, \"" . ( $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"; }