01-events.t | searchcode

/Wx-Perl-ProcessStream-0.32/t/01-events.t

#
Perl | 384 lines | 316 code | 44 blank | 24 comment | 27 complexity | 4e2d79d9c6ab70fcf1175ad8c0aebdba MD5 | raw file

#!perl
BEGIN { $ENV{WXPPS_MULTITEST} ||= 10; $ENV{WXPPS_POLLINTERVAL} ||= 100;}
package main;

use strict;
use Test::More tests => 57 + $ENV{WXPPS_MULTITEST};
use lib 't';
use Wx;
use WxTesting qw( app_from_wxtesting_frame );

my $app = app_from_wxtesting_frame( 'ProcessStreamTestingFrame' );
$app->MainLoop;

package ProcessStreamTestingFrame;
use strict;
use base qw(WxTesting::Frame);
use Wx::Perl::ProcessStream 0.30 qw( :everything );
use Test::More;
use Time::HiRes qw( sleep );


sub new {
    my $class = shift;
    my $self = $class->SUPER::new( undef, -1, 'Testing Wx::Perl::ProcessStream ');
    EVT_WXP_PROCESS_STREAM_STDOUT( $self, \&evt_process);
    EVT_WXP_PROCESS_STREAM_STDERR( $self, \&evt_process);
    EVT_WXP_PROCESS_STREAM_EXIT(   $self, \&evt_process);
    EVT_WXP_PROCESS_STREAM_MAXLINES(   $self, \&evt_process);
    $self->{_stdout} = [];
    $self->{_stderr} = [];
    $self->{_exitcode} = undef;
    $self->{_eventmode} = 'single';
    return $self;
}

sub RunTests {
    my $self = shift;   
    my $perl = $^X;
    
    # speed up tests
    Wx::Perl::ProcessStream->SetPollInterval($ENV{WXPPS_POLLINTERVAL});
    
    # test group 1
    my $cmd;
    my $process;
    my $errs;
    
    if($^O =~ /^MSWin/) {
        $cmd = [ $perl, '-e', q(print 0, qq(\n);) ];
    } else {
        $cmd = [ $perl, '-e', q(print 0, qq(\n);) ];
    }
    
    {
        $process = $self->start_process_a( $cmd );
        #ok( $process->IsAlive() );
        $self->wait_for_test_complete();
        is( $process->IsAlive(), 0 );
        is( $self->{_stdout}->[0], '0' );
        $errs = join('', @{ $self->{_stderr} });
        $errs ||= '';
        is( $errs, '' );
        is( $self->{_exitcode}, 0 );
        is( $process->GetExitCode() , 0 );
        $process->Destroy;
        $process = undef;
    }
    
    if($^O =~ /^MSWin/) {
        $cmd = [ $perl, '-e', q(print 'HELLO WORLD', qq(\n);) ];
    } else {
        $cmd = [ $perl, '-e', q(print 'HELLO WORLD', qq(\n);) ];
    }
    
    {
        $process = $self->start_process_a( $cmd );
        #ok( $process->IsAlive() );
        $self->wait_for_test_complete();
        is( $process->IsAlive(), 0 );
        is( $self->{_stdout}->[0], 'HELLO WORLD' );
        $errs = join('', @{ $self->{_stderr} });
        $errs ||= '';
        is( $errs, '' );
        is( $self->{_exitcode}, 0 );
        is( $process->GetExitCode() , 0 );
        $process->Destroy;
        $process = undef;
    }
    {
        $process = $self->start_process_b( $cmd );
        #ok( $process->IsAlive() );
        $self->wait_for_test_complete();
        is( $process->IsAlive(), 0 );
        is( $self->{_stdout}->[0], 'HELLO WORLD' );
        $errs = join('', @{ $self->{_stderr} });
        $errs ||= '';
        is( $errs, '' );
        is( $self->{_exitcode}, 0 );
        is( $process->GetExitCode() , 0 );
        $process->Destroy;
        $process = undef;
    }
    
    # test group 1a - arrref
    
    if($^O =~ /^MSWin/) {
        $cmd = [ $perl, '-e', q(print 'HELLO WORLD', qq(\n);) ];
    } else {
        $cmd = [ $perl, '-e', q(print 'HELLO WORLD', qq(\n);) ];
    }
    
    {
        $process = $self->start_process_a( $cmd );
        #ok( $process->IsAlive() );
        $self->wait_for_test_complete();
        is( $process->IsAlive(), 0 );
        is( $self->{_stdout}->[0], 'HELLO WORLD' );
        $errs = join('', @{ $self->{_stderr} });
        $errs ||= '';
        is( $errs, '' );
        is( $self->{_exitcode}, 0 );
        is( $process->GetExitCode() , 0 );
        $process->Destroy;
        $process = undef;
    }
    {
        $process = $self->start_process_b( $cmd );
        #ok( $process->IsAlive() );
        $self->wait_for_test_complete();
        is( $process->IsAlive(), 0 );
        is( $self->{_stdout}->[0], 'HELLO WORLD' );
        $errs = join('', @{ $self->{_stderr} });
        $errs ||= '';
        is( $errs, '' );
        is( $self->{_exitcode}, 0 );
        is( $process->GetExitCode() , 0 );
        $process->Destroy;
        $process = undef;
    }
    
    # test group 2
    $cmd = $perl . ' notarealtestascript.pl';
    $process = $self->start_process_b( $cmd );
    #ok( $process->IsAlive() );
    $self->wait_for_test_complete();
    is( $process->IsAlive(), 0 );
    my $out = join('', @{ $self->{_stdout} });
    $out ||= '';
    is( $out, '' );
    $errs = join('', @{ $self->{_stderr} });
    $errs ||= '';
    isnt( $errs, '' );
    isnt( $self->{_exitcode}, 0 );
    $process->Destroy;
    $process = undef;
    
    # test group 3
    if($^O =~ /^MSWin/) {
        $cmd = [ $perl, '-e', q($|=1;print 'ONE', qq(\n);sleep 1;print 'TWO', qq(\n);sleep 1;print 'THREE',qq(\n);sleep 1;print STDERR 'FOUR', qq(\n);exit(5);) ];
    } else {
        $cmd = [ $perl, '-e', q($|=1;print 'ONE', qq(\n);sleep 1;print 'TWO', qq(\n);sleep 1;print 'THREE',qq(\n);sleep 1;print STDERR 'FOUR', qq(\n);exit(5);) ];
    }
    $process = $self->start_process_b( $cmd );
    #ok( $process->IsAlive() );
    $self->wait_for_test_complete();
    is( $process->IsAlive(), 0 );
    my $bufferline = join('-', @{ $self->{_stdout } });
    $bufferline =~ s/^\-+//;
    $bufferline =~ s/\-+$//;
    is($bufferline, 'ONE-TWO-THREE' );
    $bufferline = join('-', @{ $self->{_stderr } });
    $bufferline =~ s/^\-+//;
    $bufferline =~ s/\-+$//;
    is($bufferline, 'FOUR' );
    is($self->{_exitcode}, 5 );
    $process->Destroy;
    $process = undef;
    
    # test group 4 - write STDIN
    $cmd = $perl . ' t/echo.pl';
    $process = $self->start_process_b( $cmd );
    #ok( $process->IsAlive() );
    
    $process->WriteProcess( qq(TEST STDIN 1\n) );
    $process->WriteProcess( qq(TEST STDIN 2\n) );
    $process->CloseInput();
    $self->wait_for_test_complete();
    is( $process->IsAlive(), 0 );
    $bufferline = join('-', @{ $process->GetStdOutBuffer() });
    $bufferline =~ s/^\-+//;
    $bufferline =~ s/\-+$//;
    is($bufferline, 'ECHO:TEST STDIN 1-TEST STDIN 2' );
    $errs = join('', @{ $self->{_stderr} });
    $errs ||= '';
    is( $errs, '' );
    is( $process->GetExitCode(), 123 );
    $process->Destroy;
    $process = undef;
    
    # test group 5 - shell echo program 
    if($^O =~ /^MSWin/) {
        $cmd = 'cmd.exe /C ' . $perl . ' t/shelltest.pl';
    } else {
        $cmd = '/bin/sh t/shelltest.sh';
    }

    $process = $self->start_process_b( $cmd );
    #ok( $process->IsAlive() );

    while(!defined($self->{_exitcode})) {
        if(join('-', @{ $process->GetStdOutBuffer() }) eq 'WXTEST INPUT') {
            $process->WriteProcess(qq(WX TEST DATA\n));
            $process->CloseInput();
        }
        Wx::Perl::ProcessStream::Yield();
    }
    
    is( $process->IsAlive(), 0 );
    $bufferline = join('-', @{  $self->{_stdout} });
    $bufferline =~ s/^\-+//;
    $bufferline =~ s/\-+$//;
    is($bufferline, 'WXTEST INPUT-ECHO:WX TEST DATA' );
    $errs = join('', @{ $process->GetStdErrBuffer() });
    $errs ||= '';
    is( $errs, '' );
    is( $process->GetExitCode(), 0 );
    $process->Destroy;
    $process = undef;
    
    # test group 6 - multiple instance
    
    my @multiprocs;
    $self->{_eventmode} = 'multi';
    
    for (my $i = 0; $i < $ENV{WXPPS_MULTITEST}; $i ++) {
        my $sleeptime =  1 + (int(rand(10))/ 10); # sleep between 1.1 and 1.9 seconds - we want instances to exit in random order
        my $exitcode = 1 + int(rand(100)); # exitcodes 1 to 100
        my $multicmd = 'perl -e "use Time::HiRes qw( sleep ); sleep ' . $sleeptime . '; print qq(GOODBYE WORLD FROM PID: $$ INSTANCE: ' . $i . '\n); exit(' . $exitcode . ');"';
        my $multiprocess = $self->start_process_b( $multicmd );
        my $multipid = $multiprocess->GetPid;
        $self->{_multiresult}->{$multipid}->{expected} = $exitcode;
        push(@multiprocs, $multiprocess);
    }
    # wait for all procs to end
    {
        my $stillrunning = 1;
        while($stillrunning) {
            $stillrunning = 0;
            foreach my $mpid (sort keys( %{ $self->{_multiresult} } ) ) {
                $stillrunning ++ if(!defined($self->{_multiresult}->{$mpid}->{received}));
            }
            Wx::Perl::ProcessStream::Yield();
        }
    }
    for( @multiprocs ) {
        $_->Destroy;
    }
    @multiprocs = ();
    
    foreach my $mpid (sort keys( %{ $self->{_multiresult} } ) ) {
        my $mresult = $self->{_multiresult}->{$mpid};
        ok( $mresult->{expected} > 0 && ($mresult->{expected} eq $mresult->{received}), 'check expected vs received exit code' ) or
            diag(qq(PID $mpid expected : $self->{_multiresult}->{$mpid}->{expected} : received : $self->{_multiresult}->{$mpid}->{received}));
    }
    
    # test group 7 - num procs should be zero
    
    is(Wx::Perl::ProcessStream::ProcessCount(), 0, 'check process count is zero');
    
    
    # test group 8 - maxline testing
    {
        $self->{_eventmode} = 'single';
        
        if($^O =~ /^MSWin/) {
            $cmd = [ $perl, '-e', q($x = 1200; while($x){ print qq($x\n); $x--; };) ];
        } else {
            $cmd = [ $perl, '-e', q($x = 1200; while($x){ print qq($x\n); $x--; };) ];
        }
        $self->{_maxlineevtcount} = 0;
        $process = $self->start_process_b( $cmd );
        #ok( $process->IsAlive() );
        $self->wait_for_test_complete();
        is( $process->IsAlive(), 0 );
        is( $self->{_stdout}->[0], 1200 );
        my $num = scalar @{$self->{_stdout}};
        is( $self->{_stdout}->[$num -1], 1 );
        is( $num, 1200 );
        is( $self->{_exitcode}, 0 );
        is( $process->GetExitCode() , 0 );
        $process->Destroy;
        $process = undef;
        is( $self->{_maxlineevtcount}, 1 );
        
        Wx::Perl::ProcessStream->SetDefaultMaxLines(10);
        is( Wx::Perl::ProcessStream->GetDefaultMaxLines, 10 );
        $self->{_maxlineevtcount} = 0;
        
        $process = $self->start_process_b( $cmd );
        #ok( $process->IsAlive() );
        $self->wait_for_test_complete();
        is( $process->IsAlive(), 0 );
        is( $self->{_stdout}->[0], 1200 );
        $num = scalar @{$self->{_stdout}};
        is( $self->{_stdout}->[$num -1], 1 );
        is( $num, 1200 );
        is( $self->{_exitcode}, 0 );
        is( $process->GetExitCode() , 0 );
        $process->Destroy;
        $process = undef;
        is( $self->{_maxlineevtcount}, 120 );
        
    }
    
    return 1;
}

sub start_process_a {
    my ($self, $cmd) = @_;
    $self->{_stdout} = [];
    $self->{_stderr} = [];
    $self->{_exitcode} = undef;
    my $process = Wx::Perl::ProcessStream->OpenProcess( $cmd, 'TestCmd', $self );
    die 'Failed to launch process' if(!$process);
    return $process;
}

sub start_process_b {
    my ($self, $cmd) = @_;
    $self->{_stdout} = [];
    $self->{_stderr} = [];
    $self->{_exitcode} = undef;
    my $process = Wx::Perl::ProcessStream::Process->new( $cmd, 'TestCmd', $self )->Run;
    die 'Failed to launch process' if(!$process);
    return $process;
}
    
sub wait_for_test_complete {
    my $self = shift;
    while(!defined($self->{_exitcode})) {
        Wx::Perl::ProcessStream::Yield();
        sleep 0.1;
    }
}

sub evt_shell_stdout {
    my ($self, $event) = @_;
    $event->Skip(1);
    my $line = $event->GetLine();
    push(@{ $self->{_stdout} }, $line);
    my $process = $event->GetProcess();
    if($line eq 'WXTEST INPUT') {
        $process->WriteProcess( qq(WX TEST DATA\n));
        $process->CloseInput();
    }
}
    
sub evt_process {
    my ($self, $event) = @_;
    $event->Skip(1);
    
    my $evttype = $event->GetEventType();
    my $line = $event->GetLine();
    my $process = $event->GetProcess();
    # calling with perl one liners confuses line endings
    
    if($evttype == wxpEVT_PROCESS_STREAM_STDOUT) {
        push(@{ $self->{_stdout} }, $line);
    } elsif ( $evttype == wxpEVT_PROCESS_STREAM_STDERR) {
        push(@{ $self->{_stderr} }, $line);
    } elsif ( $evttype == wxpEVT_PROCESS_STREAM_MAXLINES) {
       $self->{_maxlineevtcount} ++;
    } elsif ( $evttype == wxpEVT_PROCESS_STREAM_EXIT) {
        if( $self->{_eventmode} ne 'multi') {
            $self->{_exitcode} = $process->GetExitCode();
        } else {
            my $pid = $process->GetPid();
            my $exitcode = $process->GetExitCode();
            $self->{_multiresult}->{$pid}->{received} = $exitcode;
        }
    }
}

1;