r61437 - in /trunk/libpoe-perl: Makefile.PL t/10_units/01_pod/04_pod_linkcheck.t t/10_units/08_loops/11_double_loop.t t/90_regression/agaran-filter-httpd.t t/90_regression/hinrik-wheel-run-die.t t/90_regression/rt56417-wheel-run.t
periapt-guest at users.alioth.debian.org
periapt-guest at users.alioth.debian.org
Sun Aug 8 13:22:12 UTC 2010
Author: periapt-guest
Date: Sun Aug 8 13:21:52 2010
New Revision: 61437
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=61437
Log:
unapplying patches
Added:
trunk/libpoe-perl/t/10_units/01_pod/04_pod_linkcheck.t
trunk/libpoe-perl/t/10_units/08_loops/11_double_loop.t
trunk/libpoe-perl/t/90_regression/hinrik-wheel-run-die.t
trunk/libpoe-perl/t/90_regression/rt56417-wheel-run.t
Modified:
trunk/libpoe-perl/Makefile.PL
trunk/libpoe-perl/t/90_regression/agaran-filter-httpd.t
Modified: trunk/libpoe-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libpoe-perl/Makefile.PL?rev=61437&op=diff
==============================================================================
--- trunk/libpoe-perl/Makefile.PL (original)
+++ trunk/libpoe-perl/Makefile.PL Sun Aug 8 13:21:52 2010
@@ -6,15 +6,15 @@
# Switch to default behavior if STDIN isn't a tty.
-#unless (-t STDIN) {
-# warn(
-# "\n",
-# "=============================================\n\n",
-# "STDIN is not a terminal. Assuming --default.\n\n",
-# "=============================================\n\n",
-# );
-# push @ARGV, "--default";
-#}
+unless (-t STDIN) {
+ warn(
+ "\n",
+ "=============================================\n\n",
+ "STDIN is not a terminal. Assuming --default.\n\n",
+ "=============================================\n\n",
+ );
+ push @ARGV, "--default";
+}
# Remind the user she can use --default.
Added: trunk/libpoe-perl/t/10_units/01_pod/04_pod_linkcheck.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libpoe-perl/t/10_units/01_pod/04_pod_linkcheck.t?rev=61437&op=file
==============================================================================
--- trunk/libpoe-perl/t/10_units/01_pod/04_pod_linkcheck.t (added)
+++ trunk/libpoe-perl/t/10_units/01_pod/04_pod_linkcheck.t Sun Aug 8 13:21:52 2010
@@ -1,0 +1,22 @@
+#!/usr/bin/perl -w
+# vim: ts=2 sw=2 filetype=perl expandtab
+
+# Tests POD for invalid links
+
+use strict;
+use Test::More;
+
+BEGIN {
+ unless ( $ENV{RELEASE_TESTING} ) {
+ plan skip_all => 'enable by setting RELEASE_TESTING';
+ }
+
+ foreach my $req (qw(Test::Pod::LinkCheck)) {
+ eval "use $req";
+ if ($@) {
+ plan skip_all => "$req is needed for these tests.";
+ }
+ }
+}
+
+Test::Pod::LinkCheck->new->all_pod_ok;
Added: trunk/libpoe-perl/t/10_units/08_loops/11_double_loop.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libpoe-perl/t/10_units/08_loops/11_double_loop.t?rev=61437&op=file
==============================================================================
--- trunk/libpoe-perl/t/10_units/08_loops/11_double_loop.t (added)
+++ trunk/libpoe-perl/t/10_units/08_loops/11_double_loop.t Sun Aug 8 13:21:52 2010
@@ -1,0 +1,24 @@
+#!/usr/bin/perl -w
+# vim: ts=2 sw=2 filetype=perl expandtab
+
+use strict;
+
+use Test::More tests => 1;
+sub POE::Kernel::ASSERT_DEFAULT () { 1 }
+
+BEGIN {
+ package POE::Kernel;
+ use constant TRACE_DEFAULT => exists($INC{'Devel/Cover.pm'});
+}
+
+TODO: {
+ local $TODO = 'This needs to be investigated someday...';
+
+ # Hide warnings.
+ {
+ local $SIG{__WARN__} = sub { undef };
+ # This relies on the assumption that loading POE defaults to PoLo::Select!
+ eval "use POE; use POE::Kernel { loop => 'IO_Poll' };";
+ }
+ ok($@, "loading a loop throws an error if a loop was already loaded");
+}
Modified: trunk/libpoe-perl/t/90_regression/agaran-filter-httpd.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libpoe-perl/t/90_regression/agaran-filter-httpd.t?rev=61437&op=diff
==============================================================================
--- trunk/libpoe-perl/t/90_regression/agaran-filter-httpd.t (original)
+++ trunk/libpoe-perl/t/90_regression/agaran-filter-httpd.t Sun Aug 8 13:21:52 2010
@@ -5,10 +5,6 @@
use strict;
BEGIN {
- unless (-f 'run_network_tests') {
- print "1..0 # skip - Network access (and permission) required to run this test\n";
- exit;
- }
eval "use HTTP::Request";
if ($@) {
print "1..0 # skip - HTTP::Request needed to test POE::Filter::HTTPD\n";
Added: trunk/libpoe-perl/t/90_regression/hinrik-wheel-run-die.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libpoe-perl/t/90_regression/hinrik-wheel-run-die.t?rev=61437&op=file
==============================================================================
--- trunk/libpoe-perl/t/90_regression/hinrik-wheel-run-die.t (added)
+++ trunk/libpoe-perl/t/90_regression/hinrik-wheel-run-die.t Sun Aug 8 13:21:52 2010
@@ -1,0 +1,118 @@
+#!/usr/bin/env perl
+# vim: ts=2 sw=2 filetype=perl expandtab
+
+use strict;
+use warnings;
+use POE;
+use Test::More tests => 1;
+
+POE::Session->create(
+ package_states => [
+ (__PACKAGE__) => [ qw( _start exit timeout) ],
+ ],
+);
+
+POE::Kernel->run;
+
+sub _start {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+ $kernel->delay('timeout', 5);
+ $heap->{quickie} = WheelWrapper->new(
+ Program => sub { die },
+ ExitEvent => 'exit',
+ );
+}
+
+sub exit {
+ my ($kernel, $heap, $status) = @_[KERNEL, HEAP, ARG0];
+ isnt(($status >> 8), 0, 'Got exit status');
+ $kernel->delay('timeout');
+ $heap->{quickie}->shutdown();
+}
+
+sub timeout {
+ fail('Timed out');
+ $_[KERNEL]->signal($_[KERNEL], "DIE");
+}
+
+package WheelWrapper;
+
+use strict;
+use warnings;
+use POE;
+use POE::Wheel::Run;
+
+sub new {
+ my ($package, %args) = @_;
+ my $self = bless \%args, $package;
+
+ $self->{parent_id} = POE::Kernel->get_active_session->ID;
+
+ POE::Session->create(
+ object_states => [
+ $self => [
+ qw(
+ _start
+ _delete_wheel
+ _child_signal
+ _child_closed
+ _shutdown
+ )
+ ],
+ ],
+ );
+
+ return $self;
+}
+
+sub _start {
+ my ($kernel, $session, $self) = @_[KERNEL, SESSION, OBJECT];
+
+ my $session_id = $session->ID;
+ $self->{session_id} = $session_id;
+ $kernel->refcount_increment($session_id, __PACKAGE__);
+
+ my $wheel;
+ eval {
+ $wheel = POE::Wheel::Run->new(
+ CloseEvent => '_child_closed',
+ StdoutEvent => 'dummy',
+ Program => $self->{Program},
+ );
+ };
+
+ if ($@) {
+ chomp $@;
+ warn $@, "\n";
+ return;
+ }
+
+ $self->{wheel} = $wheel;
+ $self->{alive} = 2;
+ $kernel->sig_child($wheel->PID, '_child_signal');
+}
+
+sub _child_signal {
+ my ($kernel, $self, $pid, $status) = @_[KERNEL, OBJECT, ARG1, ARG2];
+ my $id = $self->{wheel}->PID;
+ $kernel->post($self->{parent_id}, $self->{ExitEvent}, $status);
+ $kernel->yield('_delete_wheel', $id);
+}
+
+sub _child_closed {
+ $_[KERNEL]->yield('_delete_wheel');
+}
+
+sub _delete_wheel {
+ $_[OBJECT]->{alive}--;
+ delete $_[OBJECT]->{wheel} if $_[OBJECT]->{alive} == 0;
+}
+
+sub shutdown {
+ $poe_kernel->call($_[0]->{session_id}, '_shutdown');
+}
+
+sub _shutdown {
+ $_[KERNEL]->refcount_decrement($_[OBJECT]->{session_id}, __PACKAGE__);
+}
Added: trunk/libpoe-perl/t/90_regression/rt56417-wheel-run.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libpoe-perl/t/90_regression/rt56417-wheel-run.t?rev=61437&op=file
==============================================================================
--- trunk/libpoe-perl/t/90_regression/rt56417-wheel-run.t (added)
+++ trunk/libpoe-perl/t/90_regression/rt56417-wheel-run.t Sun Aug 8 13:21:52 2010
@@ -1,0 +1,94 @@
+#!/usr/bin/perl
+# vim: ts=2 sw=2 filetype=perl expandtab
+
+use strict;
+use warnings;
+
+use Test::More;
+use File::Spec;
+use POE qw( Wheel::Run );
+
+plan tests => 4;
+
+foreach my $t ( qw( real fake ) ) {
+ my_spawn( $t );
+}
+
+$poe_kernel->run();
+exit 0;
+
+sub my_spawn {
+ POE::Session->create(
+ package_states => [
+ 'main' => [qw(_start _stop _timeout _wheel_stdout _wheel_stderr _wheel_closed _wheel_child)],
+ ],
+ 'args' => [ $_[0] ],
+ );
+}
+
+sub _start {
+ my ($kernel,$heap,$type) = @_[KERNEL,HEAP,ARG0];
+
+ $heap->{type} = $type;
+
+ my $perl;
+ if ( $type eq 'fake' ) {
+ my @path = qw(COMPLETELY MADE UP PATH TO PERL);
+ unshift @path, 'C:' if $^O eq 'MSWin32';
+ $perl = File::Spec->catfile( @path );
+ } elsif ( $type eq 'real' ) {
+ $perl = $^X;
+ }
+
+ my $program = [ $perl, '-e', 1 ];
+
+ $heap->{wheel} = POE::Wheel::Run->new(
+ Program => $program,
+ StdoutEvent => '_wheel_stdout',
+ StderrEvent => '_wheel_stderr',
+ ErrorEvent => '_wheel_error',
+ CloseEvent => '_wheel_closed',
+ );
+
+ $kernel->sig_child( $heap->{wheel}->PID, '_wheel_child' );
+ $kernel->delay( '_timeout', 60 );
+ return;
+}
+
+sub _wheel_stdout {
+ return;
+}
+
+sub _wheel_stderr {
+ return;
+}
+
+sub _wheel_closed {
+ delete $_[HEAP]->{wheel};
+ return;
+}
+
+sub _wheel_child {
+ my $exitval = $_[ARG2];
+
+ if ( $_[HEAP]->{type} eq 'real' ) {
+ ok( $exitval == 0, "Set proper exitval for '" . $_[HEAP]->{type} . "'" );
+ } else {
+ ok( $exitval > 0, "Set proper exitval for '" . $_[HEAP]->{type} . "'" );
+ }
+
+ $poe_kernel->sig_handled();
+ $poe_kernel->delay( '_timeout' );
+ return;
+}
+
+sub _stop {
+ pass("we sanely died (" . $_[HEAP]->{type} . ")");
+ return;
+}
+
+sub _timeout {
+ die "Something went seriously wrong";
+ return;
+}
+
More information about the Pkg-perl-cvs-commits
mailing list