From f37b732fa2a9f4c4e31c602fb3309bc882400ab9 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Mon, 5 Mar 2012 00:36:07 -0600 Subject: cleanups, dzil stuff, etc --- t/000-load.t | 7 ------- t/001-open-close.t | 9 --------- t/002-spawn.t | 16 --------------- t/003-subprocess.t | 21 -------------------- t/004-undefined-program.t | 15 -------------- t/010-read-write.t | 48 --------------------------------------------- t/100-system.t | 28 -------------------------- t/open-close.t | 11 +++++++++++ t/read-write.t | 50 +++++++++++++++++++++++++++++++++++++++++++++++ t/spawn.t | 18 +++++++++++++++++ t/subprocess.t | 23 ++++++++++++++++++++++ t/system.t | 30 ++++++++++++++++++++++++++++ t/undefined-program.t | 17 ++++++++++++++++ 13 files changed, 149 insertions(+), 144 deletions(-) delete mode 100644 t/000-load.t delete mode 100644 t/001-open-close.t delete mode 100644 t/002-spawn.t delete mode 100644 t/003-subprocess.t delete mode 100644 t/004-undefined-program.t delete mode 100644 t/010-read-write.t delete mode 100644 t/100-system.t create mode 100644 t/open-close.t create mode 100644 t/read-write.t create mode 100644 t/spawn.t create mode 100644 t/subprocess.t create mode 100644 t/system.t create mode 100644 t/undefined-program.t (limited to 't') diff --git a/t/000-load.t b/t/000-load.t deleted file mode 100644 index 982a1ef..0000000 --- a/t/000-load.t +++ /dev/null @@ -1,7 +0,0 @@ -#!perl -use strict; -use warnings; -use Test::More tests => 1; - -use_ok 'IO::Pty::Easy'; - diff --git a/t/001-open-close.t b/t/001-open-close.t deleted file mode 100644 index 1c9eed1..0000000 --- a/t/001-open-close.t +++ /dev/null @@ -1,9 +0,0 @@ -#!perl -use strict; -use warnings; -use Test::More tests => 1; -use IO::Pty::Easy; - -my $pty = IO::Pty::Easy->new; -$pty->close; -ok(!$pty->opened, "closing a pty before a spawn"); diff --git a/t/002-spawn.t b/t/002-spawn.t deleted file mode 100644 index 620a57a..0000000 --- a/t/002-spawn.t +++ /dev/null @@ -1,16 +0,0 @@ -#!perl -use strict; -use warnings; -use Test::More tests => 5; -use IO::Pty::Easy; - -my $pty = IO::Pty::Easy->new; -$pty->spawn("$^X -ple ''"); -ok($pty->is_active, "spawning a subprocess"); -ok($pty->kill(0, 1), "subprocess actually exists"); -$pty->kill; -ok(!$pty->is_active, "killing a subprocess"); -$pty->spawn("$^X -ple ''"); -$pty->close; -ok(!$pty->is_active, "auto-killing a pty with close()"); -ok(!$pty->opened, "closing a pty after a spawn"); diff --git a/t/003-subprocess.t b/t/003-subprocess.t deleted file mode 100644 index cc87025..0000000 --- a/t/003-subprocess.t +++ /dev/null @@ -1,21 +0,0 @@ -#!perl -use strict; -use warnings; -use Test::More tests => 2; -use IO::Pty::Easy; - -my $pty = IO::Pty::Easy->new; -my $script = << 'EOF'; -$| = 1; -if (-t *STDIN && -t *STDOUT) { print "ok" } -else { print "failed" } -EOF - -my $outside_of_pty = `$^X -e '$script'`; -unlike($outside_of_pty, qr/ok/, "running outside of pty fails -t checks"); - -# we need to keep the script alive until we can read the output from it -$script .= "sleep 1 while 1;"; -$pty->spawn("$^X -e '$script'"); -like($pty->read, qr/ok/, "runs subprocess in a pty"); -$pty->close; diff --git a/t/004-undefined-program.t b/t/004-undefined-program.t deleted file mode 100644 index 335a415..0000000 --- a/t/004-undefined-program.t +++ /dev/null @@ -1,15 +0,0 @@ -#!perl -use strict; -use warnings; -use Test::More tests => 2; -use IO::Pty::Easy; - -my $pty = IO::Pty::Easy->new; -eval { - local $SIG{ALRM} = sub { die "alarm\n" }; - alarm 5; - $pty->spawn("missing_program_io_pty_easy"); - alarm 0; -}; -like($@, qr/Cannot exec\(missing_program_io_pty_easy\)/); -ok(!$pty->is_active, "pty isn't active if program doesn't exist"); diff --git a/t/010-read-write.t b/t/010-read-write.t deleted file mode 100644 index 80f5f1e..0000000 --- a/t/010-read-write.t +++ /dev/null @@ -1,48 +0,0 @@ -#!perl -use strict; -use warnings; -use Test::More tests => 5; -use IO::Pty::Easy; - -my $pty = IO::Pty::Easy->new; - -$pty->spawn("$^X -ple ''"); -$pty->write("testing\n"); -like($pty->read, qr/testing/, "basic read/write testing"); -is($pty->read(0.1), undef, "read returns undef on timeout"); -$pty->kill; - -$pty->spawn("$^X -e 'sleep(1) while 1'"); -eval { - local $SIG{ALRM} = sub { - is($pty->write("should fail", 0.1), undef, - "write returns undef on timeout"); - $SIG{ALRM} = 'DEFAULT'; - alarm 1; - }; - alarm 1; - $pty->write('a'x(1024*1024)); -}; -$pty->kill; -$pty->close; - -# create an entirely new pty to clear the input buffer -$pty = IO::Pty::Easy->new; -$pty->spawn("$^X -e 'sleep(1) while 1'"); -my $result = "wrong"; -$result = eval { - local $SIG{ALRM} = sub { die "alarm\n" }; - alarm 2; - my $write_result = $pty->write('a'x(1024*1024), 0.1); - defined($write_result) ? "wrong" : "right"; -}; -TODO: { - local $TODO = "need to figure this one out"; - is($result, "right", "write times out properly even on the first call"); - isnt($@, "alarm\n", "write times out properly even on the first call"); -} - -# if the perl script ends with a subprocess still running, the test will exit -# with the exit status of the signal that the subprocess dies with, so we have -# to kill the subprocess before exiting. -$pty->close; diff --git a/t/100-system.t b/t/100-system.t deleted file mode 100644 index 0be6006..0000000 --- a/t/100-system.t +++ /dev/null @@ -1,28 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 4; -use IO::Pty::Easy; - -my $pty = IO::Pty::Easy->new; -$pty->spawn("$^X -ple ''"); -my $output; -eval { - local $SIG{ALRM} = sub { die "alarm\n" }; - alarm 5; - $output = `$^X -e 'print "foo"'`; - alarm 0; -}; -isnt($@, "alarm\n", "system() didn't time out"); -is($output, "foo", "system() got the right value"); -$pty->kill; -undef $output; -eval { - local $SIG{ALRM} = sub { die "alarm2\n" }; - alarm 5; - $output = `$^X -e 'print "bar"'`; - alarm 0; -}; -isnt($@, "alarm2\n", "system() didn't time out (after kill)"); -is($output, "bar", "system() got the right value (after kill)"); -$pty->close; diff --git a/t/open-close.t b/t/open-close.t new file mode 100644 index 0000000..6140821 --- /dev/null +++ b/t/open-close.t @@ -0,0 +1,11 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use IO::Pty::Easy; + +my $pty = IO::Pty::Easy->new; +$pty->close; +ok(!$pty->opened, "closing a pty before a spawn"); + +done_testing; diff --git a/t/read-write.t b/t/read-write.t new file mode 100644 index 0000000..21fe729 --- /dev/null +++ b/t/read-write.t @@ -0,0 +1,50 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use IO::Pty::Easy; + +my $pty = IO::Pty::Easy->new; + +$pty->spawn("$^X -ple ''"); +$pty->write("testing\n"); +like($pty->read, qr/testing/, "basic read/write testing"); +is($pty->read(0.1), undef, "read returns undef on timeout"); +$pty->kill; + +$pty->spawn("$^X -e 'sleep(1) while 1'"); +eval { + local $SIG{ALRM} = sub { + is($pty->write("should fail", 0.1), undef, + "write returns undef on timeout"); + $SIG{ALRM} = 'DEFAULT'; + alarm 1; + }; + alarm 1; + $pty->write('a'x(1024*1024)); +}; +$pty->kill; +$pty->close; + +# create an entirely new pty to clear the input buffer +$pty = IO::Pty::Easy->new; +$pty->spawn("$^X -e 'sleep(1) while 1'"); +my $result = "wrong"; +$result = eval { + local $SIG{ALRM} = sub { die "alarm\n" }; + alarm 2; + my $write_result = $pty->write('a'x(1024*1024), 0.1); + defined($write_result) ? "wrong" : "right"; +}; +TODO: { + local $TODO = "need to figure this one out"; + is($result, "right", "write times out properly even on the first call"); + isnt($@, "alarm\n", "write times out properly even on the first call"); +} + +# if the perl script ends with a subprocess still running, the test will exit +# with the exit status of the signal that the subprocess dies with, so we have +# to kill the subprocess before exiting. +$pty->close; + +done_testing; diff --git a/t/spawn.t b/t/spawn.t new file mode 100644 index 0000000..9bdc498 --- /dev/null +++ b/t/spawn.t @@ -0,0 +1,18 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use IO::Pty::Easy; + +my $pty = IO::Pty::Easy->new; +$pty->spawn("$^X -ple ''"); +ok($pty->is_active, "spawning a subprocess"); +ok($pty->kill(0, 1), "subprocess actually exists"); +$pty->kill; +ok(!$pty->is_active, "killing a subprocess"); +$pty->spawn("$^X -ple ''"); +$pty->close; +ok(!$pty->is_active, "auto-killing a pty with close()"); +ok(!$pty->opened, "closing a pty after a spawn"); + +done_testing; diff --git a/t/subprocess.t b/t/subprocess.t new file mode 100644 index 0000000..d889074 --- /dev/null +++ b/t/subprocess.t @@ -0,0 +1,23 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use IO::Pty::Easy; + +my $pty = IO::Pty::Easy->new; +my $script = << 'EOF'; +$| = 1; +if (-t *STDIN && -t *STDOUT) { print "ok" } +else { print "failed" } +EOF + +my $outside_of_pty = `$^X -e '$script'`; +unlike($outside_of_pty, qr/ok/, "running outside of pty fails -t checks"); + +# we need to keep the script alive until we can read the output from it +$script .= "sleep 1 while 1;"; +$pty->spawn("$^X -e '$script'"); +like($pty->read, qr/ok/, "runs subprocess in a pty"); +$pty->close; + +done_testing; diff --git a/t/system.t b/t/system.t new file mode 100644 index 0000000..c6fb29e --- /dev/null +++ b/t/system.t @@ -0,0 +1,30 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use IO::Pty::Easy; + +my $pty = IO::Pty::Easy->new; +$pty->spawn("$^X -ple ''"); +my $output; +eval { + local $SIG{ALRM} = sub { die "alarm\n" }; + alarm 5; + $output = `$^X -e 'print "foo"'`; + alarm 0; +}; +isnt($@, "alarm\n", "system() didn't time out"); +is($output, "foo", "system() got the right value"); +$pty->kill; +undef $output; +eval { + local $SIG{ALRM} = sub { die "alarm2\n" }; + alarm 5; + $output = `$^X -e 'print "bar"'`; + alarm 0; +}; +isnt($@, "alarm2\n", "system() didn't time out (after kill)"); +is($output, "bar", "system() got the right value (after kill)"); +$pty->close; + +done_testing; diff --git a/t/undefined-program.t b/t/undefined-program.t new file mode 100644 index 0000000..f53d065 --- /dev/null +++ b/t/undefined-program.t @@ -0,0 +1,17 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use IO::Pty::Easy; + +my $pty = IO::Pty::Easy->new; +eval { + local $SIG{ALRM} = sub { die "alarm\n" }; + alarm 5; + $pty->spawn("missing_program_io_pty_easy"); + alarm 0; +}; +like($@, qr/Cannot exec\(missing_program_io_pty_easy\)/); +ok(!$pty->is_active, "pty isn't active if program doesn't exist"); + +done_testing; -- cgit v1.2.3-54-g00ecf