Commits

Anonymous committed 2c45d36

start using Test::Roo

switch over to Test::Roo for some tests

Comments (0)

Files changed (4)

t/Hg/Lib/Server/Pipe/runcommand.t

 use strict;
 use warnings;
 
-use lib 't/lib';
+use t::common;
 
-use base 'Test::Hg::Lib::Server';
+use Test::Roo;
+use Test::Fatal;
+
+with 'Test::Hg::Lib::Role::Server';
 
 use Hg::Lib::Exception ':aliases';
 
-use Test::More;
-use Test::Fatal;
-
-INIT { Test::Class->runtests }
+before each_test => sub { $_[0]->start_server };
+after  each_test => sub { $_[0]->stop_server  };
 
 # test the default error channel handler
-sub echo_error : Tests {
+test 'echo error' => sub {
 
     my $self   = shift;
-    my $server = $self->{server};
 
     {
         my ( $out, $err, $exit ) = $self->run_yaml( ['echo_error'] );
         );
     }
 
-}
+};
 
 # test the default output channel handler
-sub echo_output : Tests {
+test 'echo_output' => sub {
 
     my $self   = shift;
-    my $server = $self->{server};
 
     my ( $out, $err, $exit )
       = $self->run_yaml( [ 'echo_output', '--a', 3 ] );
         "echo_output, args: --a 3"
     );
 
-}
+};
 
-sub failed : Tests {
+test 'failed' => sub {
 
     my $self   = shift;
 
     is ( $out, '', 'no output on failure' );
     is ( $err, 'failed!', 'error output on failure' );
     is ( $exit, 193, 'error code' );
-}
+};
 
-sub no_L_handler : Tests {
+test 'no L handler' => sub {
 
     my $self   = shift;
-    my $server = $self->{server};
 
     my ( $stdout, $stderr, $exit );
 
     isa_ok( $e, EPipe, 'EPipe' );
     like( $e, qr/unexpected data .* channel L/, 'message' );
 
-    $self->{stop_error} = [ EPipe, qr/unexpected termination of server/ ];
+    $self->stop_error( [ EPipe, qr/unexpected termination of server/ ] );
 
-}
+};
 
-sub L_handler : Tests {
+test 'L handler' => sub {
 
     my $self   = shift;
-    my $server = $self->{server};
 
     my $buffer;
 
     my $handle_o  = sub { $buffer .= $_[0]  };
 
     my $e = exception {
-        $server->runcommand(
-            ['read_line'],
+        $self->server->runcommand(
+            [ 'read_line' ],
             inchannels  => { L => $handle_L },
             outchannels => { o => $handle_o },
         );
     };
 
-    is( $e, undef, 'no exception' );
+    is( $e, undef, 'no exception' )
+	or do {
+	    diag "bailing";
+	    return };
+
     is( $buffer, "001\n002\n003\n004\n005\n", 'returned message' );
 
-}
+};
+
+run_me;
+done_testing;

t/Hg/Lib/Server/connect.t

 
 use t::common;
 
-use Test::More;
+use Test::Roo;
 use Test::Fatal;
 
-use File::pushd;
-
 use Hg::Lib::Server;
 use Hg::Lib::Exception ':aliases';
 
-use base 'Test::Class';
-use Capture::Tiny qw[ capture ];
+with 'Test::Hg::Lib::Role::TempDir';
 
-INIT { Test::Class->runtests };
-
-sub setup : Test( setup ) {
-
-    my $self = shift;
-
-    $self->{dir} = tempd();
-
-}
-
-sub teardown : Test( teardown ) {
-
-    my $self = shift;
-
-    # just to be forceful about it
-    delete $self->{dir};
-}
-
-sub test_norepo : Tests {
+test 'no repo'=> sub {
 
     my $e = exception{ Hg::Lib::Server->new( connect => 1, hg => hg ) };
 
     isa_ok( $e, ENoRepo, 'no repo' );
 
-}
+};
 
-sub test_repo_nopath : Tests {
+test 'repo, no path' => sub {
 
-    my ( $stdout, $stderr, $exit ) = capture {
-	system( hg, 'init' )
-    };
-
-    is ( $exit, 0, 'create repo' );
+    create_repo;
 
     my $e = exception{ Hg::Lib::Server->new( connect => 1, hg => hg ) };
 
     is( $e, undef, 'repo, no path' );
-}
+};
 
-sub test_repo_path : Tests {
+test 'repo, path' => sub {
 
-    my ( $stdout, $stderr, $exit ) = capture {
-	system( hg, 'init', 'subdir' )
-    };
-
-    is ( $exit, 0, 'create repo in subdir' );
+    create_repo( 'subdir' );
 
     my $e = exception{ Hg::Lib::Server->new( connect => 1, hg => hg,
 					   path => 'subdir' ) };
 
     is( $e, undef, 'repo, path' );
-}
+};
+
+run_me;
+done_testing;

t/lib/Test/Hg/Lib/Role/Server.pm

+#! perl
+
+package Test::Hg::Lib::Role::Server;
+
+use t::common;
+
+use Try::Tiny;
+
+use Test::Roo::Role;
+use Test::Fatal;
+
+use Types::Standard qw[ ArrayRef Str ];
+
+use Capture::Tiny 'capture';
+use YAML::Tiny;
+
+use Hg::Lib::Server;
+use Hg::Lib::Exception ':aliases';
+
+has server => (
+    is      => 'lazy',
+    clearer => 1,
+    builder => sub {
+        Hg::Lib::Server->new(
+            hg      => fake_hg,
+            args    => 'full',
+            connect => 1,
+        );
+    } );
+
+has stop_error => (
+    is        => 'rw',
+    predicate => 1,
+    clearer => 1,
+    isa       => ArrayRef,
+);
+
+sub start_server {
+
+    $_[0]->server;
+
+}
+
+sub stop_server {
+
+    my $self = shift;
+
+    my $e = exception { $self->server->close };
+
+    try {
+        if ( $self->has_stop_error ) {
+
+            my ( $exp_exception, $exp_message ) = @{ $self->stop_error };
+
+            isa_ok( $e, $exp_exception, $exp_exception )
+              or die( "bailing out" );
+            like( $e, $exp_message, 'message' );
+        }
+
+        else {
+
+            is( $e, undef, "successful server exit" );
+
+        }
+    }
+    catch {
+
+        diag $_;
+
+    }
+    finally {
+
+        $self->clear_server;
+	$self->clear_stop_error;
+
+    };
+
+}
+
+sub run {
+
+    my $self = shift;
+    my @args = @_;
+
+    return capture { $self->server->runcommand( @args ) };
+}
+
+sub run_yaml {
+
+    my $self = shift;
+
+    my ( $stdout, $stderr, $exit ) = $self->run( @_ );
+
+    return length( $stdout ) ? YAML::Tiny->read_string( $stdout ) : undef,
+      length( $stderr )      ? YAML::Tiny->read_string( $stderr ) : undef,
+      $exit;
+}
+
+1;
+

t/lib/Test/Hg/Lib/Role/TempDir.pm

+package Test::Hg::Lib::Role::TempDir;
+
+use Moo::Role;
+use Cwd qw/getcwd/;
+use File::pushd 'tempd';
+
+has tempdir => (
+    is      => 'ro',
+    default => sub { tempd() },
+    clearer => 1,
+);
+
+1;