App-Base

 view release on metacpan or  search on metacpan

t/00-compile.t  view on Meta::CPAN

use File::Spec;
use IPC::Open3;
use IO::Handle;

open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!";

my @warnings;
for my $lib (@module_files)
{
    # see L<perlfaq8/How can I capture STDERR from an external command?>
    my $stderr = IO::Handle->new;

    diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
            $^X, @switches, '-e', "require q[$lib]"))
        if $ENV{PERL_COMPILE_TEST_DEBUG};

    my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]");
    binmode $stderr, ':crlf' if $^O eq 'MSWin32';
    my @_warnings = <$stderr>;
    waitpid($pid, 0);
    is($?, 0, "$lib loaded ok");

    shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/
        and not eval { +require blib; blib->VERSION('1.01') };

    if (@_warnings)
    {
        warn @_warnings;
        push @warnings, @_warnings;

t/common.t  view on Meta::CPAN

use Test::Most;
use Test::FailWarnings;
use Test::Warn;
use Test::Exit;
use Text::Trim;

sub divert_stderr {
    my $coderef = shift;
    local *STDERR;
    is(1, open(STDERR, ">/dev/null") ? 1 : 0, "Failed to redirect STDERR");
    &$coderef;
}

use App::Base::Script::Common;

package Test::Script::Common;

t/common.t  view on Meta::CPAN

--quux=N           quux is an integer option (default: 7)
};
my $scswitches = $sc->switches;
$scswitches =~ s/\s+/ /g;
$switches   =~ s/\s+/ /g;

is($sc->getOption('help'), undef,           'help was not requested');
is($sc->run,               0,               'run() returns 0');
is($sc->script_name,       'common.t',      'script_name() returns correct value');
is(trim($scswitches),      trim($switches), 'switches() returns correct value');
divert_stderr(
    sub {
        exits_ok(sub { $sc->usage; }, "usage() method causes exit");
        warnings_like {
            exits_ok(sub { $sc->__error("Error message"); }, "__error() method causes exit");
        }
        [qr/^Error message/], "Expected warning on __error";
        throws_ok { $sc->getOption('bogus_option'); } qr/Unknown option/, 'Bogus option names cause death';

        is($sc->run, 0, 'Run returns 0');

t/script.t  view on Meta::CPAN

use Test::Most;
use Test::FailWarnings;
use Test::Warn;
use Test::Exit;
use Path::Tiny;

use App::Base::Script;

sub divert_stderr {
    my $coderef = shift;
    local *STDERR;
    is(1, open(STDERR, ">/dev/null") ? 1 : 0, "Failed to redirect STDERR");
    &$coderef;
}

{

    package Test::Script;

t/script.t  view on Meta::CPAN

my @switch_lines = split(/[\r\n]/, $switches);
my @output_lines = split(/[\r\n]/, $sc->switches);
$_ =~ s/\s+/ /g for @switch_lines;
$_ =~ s/\s+/ /g for @output_lines;
for (my $line = 0; $line < $#switch_lines; $line++) {
    is($switch_lines[$line], $output_lines[$line], "Switch output line " . ($line + 1) . " is correct");
}
is(0, $sc->run, 'Run returns 0');

divert_stderr(
    sub {
        HELP:
        {
            local @ARGV = ('--help');
            exits_ok(sub { Test::Script->new->run; }, "--help forces exit");
        }

        DEATH:
        {
            local @ARGV;