summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2012-03-05 19:44:35 -0600
committerJesse Luehrs <doy@tozt.net>2012-03-05 19:44:35 -0600
commitbff4ae8c083ad3747d31b013b37779f8ed73cfd0 (patch)
tree5f67d0683c98337733b861c4ad8c82e24ecd36fe
parentb061ca22d27fdf0a0babfb4a07e73d763d2de81d (diff)
downloadterm-filter-bff4ae8c083ad3747d31b013b37779f8ed73cfd0.tar.gz
term-filter-bff4ae8c083ad3747d31b013b37779f8ed73cfd0.zip
add test for most of the callbacks
it's a bit race-condition-y, but good enough for now
-rw-r--r--t/callbacks.t121
1 files changed, 121 insertions, 0 deletions
diff --git a/t/callbacks.t b/t/callbacks.t
new file mode 100644
index 0000000..1d690d9
--- /dev/null
+++ b/t/callbacks.t
@@ -0,0 +1,121 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+use IO::Pty::Easy;
+use IO::Select;
+
+my $script = <<'SCRIPT';
+use Term::Filter;
+my $term = Term::Filter->new(
+ callbacks => {
+ setup => sub {
+ my ($t, @cmd) = @_;
+ my $ref = ref($t);
+ print "SETUP: $t ($ref): @cmd\n";
+ },
+ cleanup => sub {
+ my ($t) = @_;
+ my $ref = ref($t);
+ print "CLEANUP: $t ($ref)\n";
+ },
+ munge_input => sub {
+ my ($t, $buf) = @_;
+ my $ref = ref($t);
+ print "MUNGE_INPUT: $t ($ref): $buf\n";
+ $buf = "\n" if $buf =~ /exit/i;
+ return uc($buf);
+ },
+ munge_output => sub {
+ my ($t, $buf) = @_;
+ my $ref = ref($t);
+ print "MUNGE_OUTPUT: $t ($ref): $buf\n";
+ return lc($buf);
+ },
+ }
+);
+print "$term\n";
+$term->run($^X, '-ple', q[last if /^$/]);
+print "done\n";
+SCRIPT
+
+my $crlf = qr/\x0d\x0a/;
+
+# just in case
+alarm 60;
+
+{
+ my $pty = IO::Pty::Easy->new(handle_pty_size => 0);
+ $pty->spawn($^X, '-Ilib', '-e', $script);
+
+ my $setup_str = full_read($pty);
+
+ my ($term_str, $ref) = $setup_str =~ m{
+ ^
+ ((.*)=.*)
+ \n
+ SETUP: \s \1 \s \(\2\):\s
+ \Q$^X\E .* \Q-ple\E .* last\ if\ /\^\$/ .*
+ \n
+ $
+ }sx;
+
+ is($ref, 'Term::Filter', "setup callback got a Term::Filter object");
+
+ $pty->write("fOo\n");
+
+ like(
+ full_read($pty),
+ qr{
+ ^
+ MUNGE_INPUT: \s \Q$term_str\E \s \($ref\): \s fOo\n
+ \n
+ MUNGE_OUTPUT: \s \Q$term_str\E \s \($ref\): \s FOO$crlf
+ \n
+ foo$crlf
+ MUNGE_OUTPUT: \s \Q$term_str\E \s \($ref\): \s FOO$crlf
+ \n
+ foo$crlf
+ $
+ }sx,
+ "munge_input and munge_output got the right arguments"
+ );
+
+ $pty->write("EXIT\n");
+
+ like(
+ full_read($pty),
+ qr{
+ ^
+ MUNGE_INPUT: \s \Q$term_str\E \s \($ref\): \s EXIT\n
+ \n
+ MUNGE_OUTPUT: \s \Q$term_str\E \s \($ref\): \s $crlf
+ \n
+ $crlf
+ CLEANUP: \s \Q$term_str\E \s \($ref\)\n
+ done\n
+ $
+ }sx,
+ "cleanup got the right arguments"
+ );
+}
+
+sub full_read {
+ my ($pty) = @_;
+
+ my $select = IO::Select->new($pty);
+ return if $select->has_exception(0.1);
+
+ my $ret;
+ while ($select->can_read(1)) {
+ my $new = $pty->read;
+ last unless defined($new) && length($new);
+ $ret .= $new;
+ return $ret if $select->has_exception(0.1);
+ }
+
+ return $ret;
+}
+
+done_testing;