view release on metacpan or  search on metacpan

t/base.t  view on Meta::CPAN

$input = lc substr $yes, 0, 1;
$unattended = 0;
is capture_stdout {
    ok $sqitch->ask_y_n('hi'),
        qq{ask_y_n should return true for "$input" input}
}, 'hi ', 'ask_y_n() should prompt';

$input = lc substr $no, 0, 1;
is capture_stdout {
    ok !$sqitch->ask_y_n('howdy'),
        qq{ask_y_n should return false for "$input" input}
}, 'howdy ', 'ask_y_n() should prompt for no';

$input = uc substr $no, 0, 1;
is capture_stdout {
    ok !$sqitch->ask_y_n('howdy'),
        qq{ask_y_n should return false for "$input" input}
}, 'howdy ', 'ask_y_n() should prompt for no';

$input = uc substr $yes, 0, 2;
is capture_stdout {
    ok $sqitch->ask_y_n('howdy'),
        qq{ask_y_n should return true for "$input" input}
}, 'howdy ', 'ask_y_n() should prompt for yes';

$input = '';
is capture_stdout {
    ok $sqitch->ask_y_n('whu?', 'y'),
        qq{ask_y_n should return true default "$yes"}
}, "whu? [$yes] ", 'ask_y_n() should prompt and show default "Yes"';

is capture_stdout {
    ok !$sqitch->ask_y_n('whu?', 'n'),
        qq{ask_y_n should return false default "$no"};
}, "whu? [$no] ", 'ask_y_n() should prompt and show default "No"';

$input = 'ha!';
throws_ok {
    is capture_stdout { $sqitch->ask_y_n('hi')  },
        "hi  \n$please\nhi  \n$please\nhi  \n",
         'Should get prompts for repeated bad answers';
} 'App::Sqitch::X', 'Should get error for bad answers';
is $@->ident, 'io', 'Bad answers ident should be "IO"';
is $@->message, __ 'No valid answer after 3 attempts; aborting',
    'Bad answers message should be correct';

##############################################################################
# Test _readline.
$sqitch_mock->unmock('_readline');
$input = 'hep';
open my $stdin, '<', \$input;
*STDIN = $stdin;
is $sqitch->_readline, $input, '_readline should work';

$unattended = 1;
is $sqitch->_readline, undef, '_readline should return undef when unattended';
$sqitch_mock->unmock_all;

##############################################################################
# Make sure Test::LocaleDomain gives us decoded strings.
for my $lang (qw(en fr)) {
    local $ENV{LANGUAGE} = $lang;
    my $text = __x 'On database {db}', db => 'foo';
    ok utf8::valid($text), 'Localied string should be valid UTF-8';
    ok utf8::is_utf8($text), 'Localied string should be decoded';
}

##############################################################################
# Test interactivity.
lives_ok { $CLASS->_is_interactive } '_is_interactive should not die';
lives_ok { $CLASS->_is_unattended } '_is_unattended should not die';

# Test utilities.
is $CLASS->_bn(__FILE__), 'base.t', '_bn should work';