Permalink
Browse files

Some strawberry fixes

 * sig-int is sent to parent and child in strawberry
 * detach is not for win32
  • Loading branch information...
exodist committed Aug 27, 2010
1 parent e990eca commit eb773f1c73e6f0e9924ad00b3f8f2cec481c1b25
Showing with 19 additions and 8 deletions.
  1. +19 −8 t/Child.t
View
@@ -35,7 +35,10 @@ $proc = $CLASS->new( sub { sleep 100 } )->start;
my $ret = eval { $proc->say("XXX"); 1 };
ok( !$ret, "Died, no IPC" );
like( $@, qr/Child was created without IPC support./, "No IPC" );
-$proc->kill(2);
+{
+ local $SIG{INT} = sub {} if $^O eq 'MSWin32';
+ $proc->kill(2);
+}
$proc = $CLASS->new( sub {
my $self = shift;
@@ -46,7 +49,10 @@ $proc = $CLASS->new( sub {
$proc->read;
sleep 1;
-ok( $proc->kill(2), "Send signal" );
+{
+ local $SIG{INT} = sub {} if $^O eq 'MSWin32';
+ ok( $proc->kill(2), "Send signal" );
+}
ok( !$proc->wait, "wait" );
ok( $proc->is_complete, "Complete" );
is( $proc->exit_status, 2, "Exit 2" );
@@ -70,12 +76,17 @@ my $end = time;
ok( $end - $start > 2, "No autoflush" );
-$proc = $CLASS->new( sub {
- my $self = shift;
- $self->detach;
- $self->say( $self->detached );
-}, pipe => 1 )->start;
+if ($^O eq 'MSWin32') {
+ skip "detach is not available on win32", 1;
+}
+else {
+ $proc = $CLASS->new( sub {
+ my $self = shift;
+ $self->detach;
+ $self->say( $self->detached );
+ }, pipe => 1 )->start;
-is( $proc->read(), $proc->pid . "\n", "Child detached" );
+ is( $proc->read(), $proc->pid . "\n", "Child detached" );
+}
done_testing;

0 comments on commit eb773f1

Please sign in to comment.