verify results from the CPAN

App-perlbrew

        it "should display clone modules from current-perl to X", sub {
            my $app = App::perlbrew->new("clone-modules", "perl-5.14.1");

            my $mock = mocked($app)->expects("current_env")->returns("perl-5.16.0")->at_least(1);
            $app->run;

            is $__from, "perl-5.16.0";
            is $__to, "perl-5.14.1";
            ok(!defined($__notest));

            $mock->verify;
        };
    };

    describe "when invoked with one argument X, with `--notest`", sub {
        it "should display clone modules from current-perl to X", sub {
            my $app = App::perlbrew->new("clone-modules", "--notest", "perl-5.14.1");
            my $mock = mocked($app)->expects("current_env")->returns("perl-5.16.0")->at_least(1);
            $app->run;

            is $__from, "perl-5.16.0";
            is $__to, "perl-5.14.1";
            ok(defined($__notest));
            $mock->verify;
        };
    };
};

done_testing;

t/command-exec.t view on Meta::CPAN

                    my $mock2 = mocked('App::perlbrew');
                    $mock2->expects("do_exit_with_error_code")->exactly(1)->returns(sub { die "simulate exit\n" });

                    stderr_is sub {
                        eval { $app->run; 1; };
                    }, <<"OUT";
Command [perl -E 'somesub 42'] terminated with exit code 7 (\$? = 1792) under the following perl environment:
format_info_output_value
OUT

                    $mock2->verify;
                }
            )
        };

        it "should be quiet if asked" => sub {
            my $app = App::perlbrew->new(qw(exec --quiet --with), "perl-5.14.1", qw(perl -E), "somesub 42");

            my $mock = mocked($app);
            $mock->expects("format_info_output")->exactly(0)->returns('should not be called!');
            $mock->expects("do_system_with_exit_code")->exactly(1)->returns(7<<8);

            my $mock2 = mocked('App::perlbrew');
            $mock2->expects("do_exit_with_error_code")->exactly(1)->returns(sub { die "simulate exit\n" });

            stderr_is sub {
                eval { $app->run; 1; };
            }, '';

            $mock->verify;
            $mock2->verify;
        };

        it "should format info output for right perl" => sub {
            my $app = App::perlbrew->new(qw(exec --with), "perl-5.14.1", qw(perl -E), "somesub 42");

            my $mock = mocked($app);
            $mock->expects("format_info_output")->exactly(1)->returns(sub {
                my ($self) = @_;
                is $self->current_env, 'perl-5.14.1';
                like $self->installed_perl_executable('perl-5.14.1'), qr/perl-5.14.1/;

t/command-exec.t view on Meta::CPAN

            });
            $mock->expects("do_system_with_exit_code")->exactly(1)->returns(7<<8);

            my $mock2 = mocked('App::perlbrew');
            $mock2->expects("do_exit_with_error_code")->exactly(1)->returns(sub {
                die "simulate exit\n";
            });

            eval { $app->run; 1; };

            $mock->verify;
            $mock2->verify;
        };
    };

    describe "no halt-on-error" => sub {
        it "should exit with success code when several perls ran" => sub {
            my $mock2 = mocked('App::perlbrew')->expects("do_exit_with_error_code")->never;

            mocked(
                App::perlbrew->new(qw(exec --with), "perl-5.14.1 perl-5.14.1", qw(perl -E), "say 42"),
                sub {
                    my ($mock, $app) = @_;
                    $mock->expects("do_system_with_exit_code")->exactly(2)->returns(0);
                    $app->run;
                }
            );

            $mock2->verify;
        };

        it "should exit with error code " => sub {
            my $app = App::perlbrew->new(qw(exec --with), "perl-5.14.1", qw(perl -E), "say 42");

            my $mock = mocked($app);
            $mock->expects("format_info_output")->exactly(1)->returns('');
            $mock->expects("do_system_with_exit_code")->exactly(1)->returns(3<<8);

            my $mock2 = mocked('App::perlbrew')->expects("do_exit_with_error_code")->exactly(1)->returns(sub {
                my ($self, $code) = @_;
                is $code, 1; # exit with error, but don't propogate exact failure codes
                die "simulate exit\n";
            });


            ok !eval { $app->run; 1; };
            is $@, "simulate exit\n";

            $mock->verify;
            $mock2->verify;
        };

        it "should exit with error code when several perls ran" => sub {
            my $app = App::perlbrew->new(qw(exec --with), "perl-5.14.1 perl-5.14.1", qw(perl -E), "say 42");

            my $mock = mocked($app);
            $mock->expects("format_info_output")->exactly(1)->returns('');
            my $calls = 0;
            $mock->expects("do_system_with_exit_code")->exactly(2)->returns(sub {
                $calls++;

t/command-exec.t view on Meta::CPAN


            my $mock2 = mocked('App::perlbrew')->expects("do_exit_with_error_code")->exactly(1)->returns(sub {
                my ($self, $code) = @_;
                is $code, 1; # exit with error, but don't propogate exact failure codes
                die "simulate exit\n";
            });

            ok !eval { $app->run; 1; };
            is $@, "simulate exit\n";

            $mock->verify;
            $mock2->verify;
        };
    };

    describe "halt-on-error" => sub {
        it "should exit with success code " => sub {
            my $app = App::perlbrew->new(qw(exec --halt-on-error --with), "perl-5.14.1", qw(perl -E), "say 42");
            my $mock = mocked('App::perlbrew')->expects("do_exit_with_error_code")->never;
            my $mock2 = mocked($app)->expects("do_system_with_exit_code")->exactly(1)->returns(0);
            $app->run;
            $mock->verify;
            $mock2->verify;
        };

        it "should exit with error code " => sub {
            my $app = App::perlbrew->new(qw(exec --halt-on-error --with), "perl-5.14.1", qw(perl -E), "say 42");

            my $mock = mocked($app);
            $mock->expects("format_info_output")->exactly(1)->returns('');
            $mock->expects("do_system_with_exit_code")->exactly(1)->returns(3<<8);

            my $mock2 = mocked('App::perlbrew')->expects("do_exit_with_error_code")->exactly(1)->returns(sub {
                my ($self, $code) = @_;
                is $code, 3;
                die "simulate exit\n";
            });

            ok !eval { $app->run; 1; };
            is $@, "simulate exit\n";

            $mock->verify;
            $mock2->verify;
        };

        it "should exit with code 255 if program terminated with signal or something" => sub {
            my $app = App::perlbrew->new(qw(exec --halt-on-error --with), "perl-5.14.1", qw(perl -E), "say 42");

            my $mock = mocked($app);
            $mock->expects("format_info_output")->exactly(1)->returns('');
            $mock->expects("do_system_with_exit_code")->exactly(1)->returns(-1);

            my $mock2 = mocked('App::perlbrew')->expects("do_exit_with_error_code")->exactly(1)->returns(sub {
                my ($self, $code) = @_;
                is $code, 255;
                die "simulate exit\n";
            });

            ok !eval { $app->run; 1; };
            is $@, "simulate exit\n";

            $mock->verify;
            $mock2->verify;
        };

        it "should exit with error code when several perls ran" => sub {
            my $app = App::perlbrew->new(qw(exec --halt-on-error --with), "perl-5.14.1 perl-5.14.1", qw(perl -E), "say 42");

            my $mock = mocked($app);
            $mock->expects("format_info_output")->exactly(1)->returns('');
            my $calls = 0;
            $mock->expects("do_system_with_exit_code")->exactly(2)->returns(sub {
                $calls++;

t/command-exec.t view on Meta::CPAN


            my $mock2 = mocked('App::perlbrew')->expects("do_exit_with_error_code")->exactly(1)->returns(sub {
                my ($self, $code) = @_;
                is $code, 7;
                die "simulate exit\n";
            });

            ok !eval { $app->run; 1; };
            is $@, "simulate exit\n";

            $mock->verify;
            $mock2->verify;
        };
    };
};

describe "minimal perl version" => sub {
    it "only executes the needed version" => sub {
        my @perl_paths;
        my $app = App::perlbrew->new(qw(exec --min 5.014), qw(perl -E), "say 42");

        my $mock = mocked($app)->expects("do_system_with_exit_code")->exactly(2)->returns(sub {

t/command-exec.t view on Meta::CPAN

        });

        $app->run;

        # Don't care about the order, just the fact all of them were visited
        is [sort @perl_paths], [sort (
            App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.14.2", "bin")->stringify(),
            App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.14.1", "bin")->stringify(),
        )];

        $mock->verify;
    };
};

describe "maximum perl version" => sub {
    it "only executes the needed version" => sub {
        my @perl_paths;
        my $app = App::perlbrew->new(qw(exec --max 5.014), qw(perl -E), "say 42");

        my $mock = mocked($app)->expects("do_system_with_exit_code")->exactly(2)->returns(sub {
            my ($self, @args) = @_;

t/command-exec.t view on Meta::CPAN

        });

        $app->run;

        # Don't care about the order, just the fact all of them were visited
        is [sort @perl_paths], [sort (
            App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.12.4", "bin")->stringify(),
            App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.12.3", "bin")->stringify(),
        )];

        $mock->verify;
    };
};

done_testing;

t/command-install-from-archive.t view on Meta::CPAN

            $mock->expects($params{method})
                ->with(@{ $params{with_args} })
                ->returns(undef);
        } else {
            $mock->expects($params{method})
                ->returns(undef);
        }

        $app->run;

        $mock->verify;
        $mock->reset;
    };
}

t/command-install.t view on Meta::CPAN

use FindBin;
use lib $FindBin::Bin;
use App::perlbrew;
require 'test2_helpers.pl';

describe "command install" => sub {
    it "should install exact perl version" => sub {
        my $app = App::perlbrew->new(install => 'perl-5.12.1');
        my $mock = mocked($app)->expects('do_install_release')->with('perl-5.12.1', '5.12.1');
        $app->run;
        $mock->verify;
    };

    it "should install exact cperl version" => sub {
        my $app = App::perlbrew->new(install => 'cperl-5.26.4');
        my $mock = mocked($app)->expects('do_install_release')->with('cperl-5.26.4', '5.26.4');
        $app->run;
        $mock->verify;
    };

    it "should install stable version of perl" => sub {
        my @versions_sorted_from_new_to_old = qw( perl-5.29.0 perl-5.14.2 perl-5.14.1 perl-5.12.3 perl-5.12.2 );

        my $app = App::perlbrew->new(install => 'perl-stable');

        my $mock = mocked($app);
        $mock->expects('available_perls')->returns(sub { @versions_sorted_from_new_to_old });
        $mock->expects('do_install_release')->with('perl-5.14.2', '5.14.2');

        $app->run;
        $mock->verify;
    };

    it "should install blead perl" => sub {
        my $app = App::perlbrew->new(install => 'perl-blead');

        my $mock = mocked($app);
        $mock->expects('do_install_release')->never;
        $mock->expects('do_install_blead')->exactly(1)->returns(sub { "dummy" });

        $app->run;
        $mock->verify;
    };

    it "should install git checkout" => sub {
        my $checkout = tempdir (CLEANUP => 1);
        dir ($checkout, '.git')->mkpath;

        my $app = App::perlbrew->new(install => $checkout);

        my $mock = mocked($app);
        $mock->expects('do_install_git')->with($checkout)->returns(sub { "dummy" });

        $app->run;
        $mock->verify;
    };

    it "should install from archive" => sub {
        my $checkout = tempdir (CLEANUP => 1);
        my $file = file ($checkout, 'archive.tar.gz')->stringify;
        open my $fh, '>', $file;
        close $fh;

        my $app = App::perlbrew->new(install => $file);

        my $mock = mocked($app)->expects('do_install_archive')->with($file)->returns(sub { "dummy" });

        $app->run;
        $mock->verify;
    };

    it "should install from uri" => sub {
        my $app = App::perlbrew->new(install => 'http://example.com/foo/bar');

        my $mock = mocked($app)->expects('do_install_url')->with('http://example.com/foo/bar')->returns(sub { "dummy" });

        $app->run;
        $mock->verify;
    };
};

done_testing;

t/test2_helpers.pl view on Meta::CPAN

}

# Wrappers around Test2::Tools::Mock, a replacement of Test::Spec, more or less.

sub mocked {
    my ($object, $cb) = @_;
    my $mocked = Mocked->new($object);

    if (defined($cb)) {
        $cb->($mocked, $object);
        $mocked->verify;
    } else {
        return $mocked;
    }
}

package Mocked; {
    use Test2::Tools::Mock qw(mock);

    sub new {
        my ($class, $object) = @_;

t/test2_helpers.pl view on Meta::CPAN

        }
    }

    sub expects {
        my ($self, $method) = @_;
        my $mockedMethod = MockedMethod->new($self, $method);
        push @{$self->{methods}}, $mockedMethod;
        return $mockedMethod;
    }

    sub verify {
        my ($self) = @_;
        for (@{$self->{methods}}) {
            $_->verify();
        }
    }

    sub reset {
        my ($self) = @_;
        $self->{mock}->reset_all;
        $self->{methods} = [];
    }
}

t/test2_helpers.pl view on Meta::CPAN

        $self->{returns} = $cb_or_value;
        return $self;
    }

    sub with {
        my ($self, @args) = @_;
        $self->{with} = \@args;
        return $self;
    }

    sub verify {
        my ($self) = @_;

        if (defined $self->{with}) {
            is $self->{called_with}, $self->{with}, "method " . $self->{method} . " is called with expected arguments";
        }

        if (defined $self->{exactly}) {
            is $self->{called}, $self->{exactly}, $self->{method} . " should be called exactly " . $self->{exactly} . " times";
        }
        elsif (defined $self->{at_least}) {

( run in 2.397 seconds using v1.01-cache-2.11-cpan-e1769b4cff6 )