diff --git a/tests/blackcore/scripts/perllib/BlackCore/Expect/Dict.pm b/tests/blackcore/scripts/perllib/BlackCore/Expect/Dict.pm new file mode 100644 index 000000000..e68cc8232 --- /dev/null +++ b/tests/blackcore/scripts/perllib/BlackCore/Expect/Dict.pm @@ -0,0 +1,144 @@ +# +# Copyright (C) 2013 VATSIM Community / authors +# This Source Code Form is subject to the terms of the Mozilla Public License, +# version 2.0. If a copy of the MPL was not distributed with this file, you can +# obtain one at http://mozilla.org/MPL/2.0 +# +# This program is also separately licensed under the same terms as Perl itself. +# +############################################################################## +# +# This package offers an extra interface on top of Expect.pm, based on a +# dictionary of patterns which can be dynamically enabled and disabled. +# + +## +## $dict = Dict->new($expect) +## Constructor, returns a new Dict object. +## $expect : The Expect object to be used. +## +## $key = $dict->add($pattern, $disabled_cb, $enabled_cb) +## Adds a pattern to the dictionary, which will be initially disabled. +## Returns a key object which can be used to refer to the pattern later. +## $pattern : A simple string or regex object. +## $disabled_cb : A callback to be called when the disabled pattern matches. +## $enabled_cb : A callback to be called when the enabled pattern matches. +## +## $key = $dict->add_enabled($pattern, $disabled_cb, $enabled_cb) +## As add(), but the pattern will be initially enabled. +## +## $dict->enable($key) +## Enable a pattern. +## $key : As returned by add() or add_enabled(). +## +## $dict->disable($key) +## Disable a pattern. +## $key : As returned by add() or add_enabled(). +## +## $state = $dict->save_state() +## Returns a representation of the current state of the dictionary, which +## can be restored later. +## +## $dict->restore_state($state) +## Revert the dictionary to the state represented by $state. +## +## $dict->expect($timeout) +## Calls $expect->expect() with the patterns of the dictionary. +## $timeout : Time to wait in seconds. + +package BlackCore::Expect::Dict; +use strict; +use warnings; + +sub new +{ + my ($pkg, $expect) = @_; + die unless $expect->isa('Expect'); + + return bless { + expect => $expect, + patterns => {}, + enabled_patterns => {} + } => $pkg; +} + +sub add +{ + my ($self, $pattern, $disabled_cb, $enabled_cb) = @_; + + my $key = keys %{ $self->{patterns} }; + $self->{patterns}{$key} = [ $pattern, $disabled_cb, $enabled_cb ]; + return $key; +} + +sub add_enabled +{ + my ($self, @args) = @_; + + my $key = $self->add(@args); + $self->enable($key); + return $key; +} + +sub enable +{ + my ($self, $key) = @_; + + $self->{enabled_patterns}{$key} = 1; +} + +sub disable +{ + my ($self, $key) = @_; + + delete $self->{enabled_patterns}{$key} + if exists $self->{enabled_patterns}{$key}; +} + +sub save_state +{ + my ($self) = @_; + + return \%{ $self->{enabled_patterns} }; +} + +sub restore_state +{ + my ($self, $state) = @_; + + %{ $self->{enabled_patterns} } = %$state; +} + +sub expect +{ + my ($self, $timeout) = @_; + + my @args; + my $last_key = scalar(keys %{ $self->{patterns} }) - 1; + foreach my $key (0..$last_key) + { + my $pattern = $self->{patterns}{$key}[0]; + push @args, [ $pattern, sub { return $self->_matched($key) } ]; + } + + my @result = $self->{expect}->expect($timeout, @args); + + if (wantarray) { + return @result; + } else { + return $result[0]; + } +} + +sub _matched +{ + my ($self, $key) = @_; + + if (exists $self->{enabled_patterns}{$key}) { + return $self->{patterns}{$key}[2](); + } else { + return $self->{patterns}{$key}[1](); + } +} + +1; \ No newline at end of file diff --git a/tests/blackcore/scripts/perllib/BlackCore/Expect/Test.pm b/tests/blackcore/scripts/perllib/BlackCore/Expect/Test.pm new file mode 100644 index 000000000..b105892fc --- /dev/null +++ b/tests/blackcore/scripts/perllib/BlackCore/Expect/Test.pm @@ -0,0 +1,171 @@ +# +# Copyright (C) 2013 VATSIM Community / authors +# This Source Code Form is subject to the terms of the Mozilla Public License, +# version 2.0. If a copy of the MPL was not distributed with this file, you can +# obtain one at http://mozilla.org/MPL/2.0 +# +# This program is also separately licensed under the same terms as Perl itself. +# +############################################################################## +# +# This package offers a procedural interface for specifying and running simple +# unit tests of interactive commandline programs, implemented using Expect.pm. +# + +## +## All commandline arguments of the script are passed to Expect::spawn(). +## Therefore the first argument must be the name of the program to be tested. +## +## Expect.pm depends on IO::Pty, which only supports true Unix operating +## systems. On Windows, this means Cygwin only. MinGW, ActiveState or +## Strawberry Perl will not work. +## +## put($lines...) +## Prints $lines to stdin of the program under test. +## +## set_timeout($seconds) +## Set the number of seconds to wait for expected responses before returning +## an error. +## +## add_test($text, $patterns...) +## Add a test. +## $text : The text to print to stdin of the program under test. +## $patterns : One or more patterns which are expected to sequentially match +## the responses received from stdout of the program under test. +## +## add_ok($pattern) +## Add a pattern which will always be ignored if it matches while waiting +## for a response during a test. +## +## add_fail($pattern) +## Add a pattern which will always cause a test to fail if it matches while +## waiting for a response. +## +## run_tests() +## Run all defined tests in sequence, and print the results. +## +## Patterns can be simple strings, or regex objects. +## + +package BlackCore::Expect::Test; +use strict; +use warnings; +use BlackCore::Expect::Dict; +use Expect; +use IO::String; +use base 'Exporter'; +our @EXPORT = qw(add_test add_ok add_fail run_tests put set_timeout); + +@ARGV > 0 or _usage(); +$ARGV[0] =~ m'^-' and _usage(); + +our $timeout = 10; +our $expect = Expect->new; +our $log = IO::String->new; +$expect->raw_pty(1); +$expect->log_stdout(0); +$expect->log_file($log); +$expect->spawn(@ARGV) or die "$!"; +our $dict = BlackCore::Expect::Dict->new($expect); + +sub put +{ + print $log "$_\n" for @_; + $expect->print("$_\n") for @_; +} + +sub set_timeout +{ + $timeout = shift; +} + +sub add_test +{ + my ($print_test, @pattern_seq) = @_; + + my @pattern_keys; + foreach my $pattern (@pattern_seq) { + push @pattern_keys, $dict->add($pattern, \&_test_fail, \&_test_ok); + } + + chomp $print_test; + $print_test =~ m'(\S+)\N*$'; + my $name = $1 || ''; + push our @tests, [ $name, $print_test, @pattern_keys ]; +} + +sub add_ok +{ + my ($pattern) = @_; + + $dict->add_enabled($pattern, (sub { exp_continue_timeout }) x 2); +} + +sub add_fail +{ + my ($pattern) = @_; + + $dict->add($pattern, \&_test_fail, \&_test_fail); +} + +sub run_tests +{ + our $passes = 0; + our $fails = 0; + my $total = 0; + + foreach my $test (our @tests) + { + my ($name, $print_test, @pattern_keys) = @$test; + + my $dots = '.' x (40 - length $name); + + print $log "$print_test\n"; + $expect->print("$print_test\n"); + foreach my $key (@pattern_keys) { + $total++; + print "Testing $name$dots"; + $dict->enable($key); + my $pos = $dict->expect($timeout); + $dict->disable($key); + _check_result(); + defined $pos or print $expect->error . "\n"; + } + } + + print "Log:\n" . ${ $expect->log_file->string_ref }; + + my $errors = $total - $passes - $fails; + print "\n$total TESTS, $passes PASSED, $fails FAILED, $errors ERRORS\n"; +} + +sub _test_fail +{ + our $test_status = 'fail'; + (our $fails)++; +} + +sub _test_ok +{ + our $test_status = 'ok'; + (our $passes)++; +} + +sub _check_result +{ + if (our $test_status) { + print "$test_status\n"; + $test_status eq 'ok' or print "Received: " . $expect->match . "\n"; + undef $test_status; + } else { + print "error\n"; + } +} + +sub _usage +{ + print "Usage:\n $0 \nRun tests on .\n"; + exit; +} + +1; \ No newline at end of file diff --git a/tests/blackcore/scripts/test_sample_cli_client.pl b/tests/blackcore/scripts/test_sample_cli_client.pl new file mode 100644 index 000000000..903a05363 --- /dev/null +++ b/tests/blackcore/scripts/test_sample_cli_client.pl @@ -0,0 +1,34 @@ +#!/usr/bin/perl +# +# Copyright (C) 2013 VATSIM Community / authors +# This Source Code Form is subject to the terms of the Mozilla Public License, +# version 2.0. If a copy of the MPL was not distributed with this file, you can +# obtain one at http://mozilla.org/MPL/2.0 +# + +use strict; +use warnings; +use lib::abs 'perllib'; +use BlackCore::Expect::Test; + +my $callsign = 'TEST01'; +set_timeout(10); + +add_test(<<"", 'CONN_STATUS_CONNECTING', 'CONN_STATUS_CONNECTED'); +setserver vatsim-germany.org 6809 +setuser guest guest +setrealname Pilot Client Tester +setcallsign $callsign +initconnect + +add_test('ping server', qr'PONG server'); + +add_test('termconnect', 'CONN_STATUS_DISCONNECTED'); + +add_ok(qr"PRIV_MSG server -> $callsign"); + +add_fail('Cannot exec'); + +run_tests(); + +put('exit'); \ No newline at end of file