view release on metacpan or  search on metacpan

t/01_basic.t  view on Meta::CPAN

    is $error, '502 Bad Gateway: ' . ('x' x 200) . '...', 'only the start of a long body';
};

subtest 'report exits non-zero when the upload fails' => sub {
    local @ENV{@CI_VARS};
    local $ENV{COVERALLS_REPO_TOKEN} = 'abcdef';
    my $db = bless {}, 'Local::FakeDB';
    no warnings 'once', 'redefine';
    local *Local::FakeDB::cover = sub { bless {}, 'Local::FakeCover' };
    # Never reach Coveralls from the tests.
    my $response;
    local *HTTP::Tiny::post_form = sub { $response };
    my $run = sub {
        my $out = '';
        open my $fh, '>', \$out or die $!;
        my $old = select $fh;
        my $ok = eval { Devel::Cover::Report::Coveralls->report($db, { file => [] }); 1 };
        my $err = $@;
        select $old;
        return ($ok, $err, $out);
    };

    $response = { success => '', status => 422, reason => 'Unprocessable Entity',
        content => '{"message":"Couldn\'t find a repository matching this job."}' };
    my ($ok, $err, $out) = $run->();
    ok !$ok, 'dies on an API error';
    like $err, qr/COVERALLS_NO_FAIL/, 'says how to exit 0';
    like $out, qr/^error: Couldn't find a repository/m, 'prints the error';

    $response = { success => '', status => 599, reason => 'Internal Exception',
        content => "Could not connect to 'coveralls.io:443'\n" };
    ($ok, $err, $out) = $run->();
    ok !$ok, 'dies on a failed connection';
    like $out, qr/^error: 599 Internal Exception: Could not connect/m, 'prints the error';

    {
        local $ENV{COVERALLS_REPO_TOKEN};
        ($ok, $err, $out) = $run->();
        ok !$ok, 'dies without a repo token';
        like $err, qr/COVERALLS_REPO_TOKEN/, 'says which variable to set';

        local $ENV{COVERALLS_NO_FAIL} = '1';
        ($ok, $err, $out) = $run->();
        ok $ok, 'returns without a repo token with COVERALLS_NO_FAIL';
        like $out, qr/^error: required repo_token/m, 'prints the error';
    }

    local $ENV{COVERALLS_NO_FAIL} = 'true';
    ($ok, $err, $out) = $run->();
    ok $ok, 'returns with COVERALLS_NO_FAIL';
    like $out, qr/^error: /m, 'still prints the error';

    local $ENV{COVERALLS_NO_FAIL} = 'false';
    $response = { success => 1, status => 200, reason => 'OK',
        content => '{"url":"https://coveralls.io/jobs/1"}' };
    ($ok, $err, $out) = $run->();
    ok $ok, 'returns on success';
    like $out, qr{^register: https://coveralls.io/jobs/1$}m, 'prints the job';
};

subtest 'strip_url_credentials' => sub {
    my %cases = (
        'https://gitlab-ci-token:SECRET@gitlab.example.com/x/y.git' => 'https://gitlab.example.com/x/y.git',
        'https://user@github.com/x/y.git'                         => 'https://github.com/x/y.git',
        'https://user:p@ss@github.com/x/y.git'                    => 'https://github.com/x/y.git',
        'ssh://git@github.com/x/y.git'                            => 'ssh://github.com/x/y.git',
        'https://github.com/x/y.git'                              => 'https://github.com/x/y.git',
        'https://github.com/x/y@z.git'                            => 'https://github.com/x/y@z.git',
        'https://github.com?x=a@b'                                => 'https://github.com?x=a@b',
        'git@github.com:x/y.git'                                  => 'git@github.com:x/y.git',
        '/path/to/repo.git'                                       => '/path/to/repo.git',
    );
    for my $url (sort keys %cases) {
        is Devel::Cover::Report::Coveralls::strip_url_credentials($url), $cases{$url}, $url;
    }
};

subtest 'parse_git_remotes' => sub {
    my $text = join '', map { "$_\n" }
        "origin\thttps://gitlab-ci-token:SECRET\@gitlab.example.com/x/y.git (fetch)",
        "origin\thttps://gitlab-ci-token:SECRET\@gitlab.example.com/x/y.git (push)",
        "upstream\tgit\@github.com:x/y.git (fetch)",
        "upstream\tgit\@github.com:x/y.git (push)",
        "local\tC:/Users/John Doe/repo (fetch)\r",
        "local\tC:/Users/John Doe/repo (push)\r";

    is_deeply Devel::Cover::Report::Coveralls::parse_git_remotes($text), [
        { name => 'origin',   url => 'https://gitlab.example.com/x/y.git' },
        { name => 'upstream', url => 'git@github.com:x/y.git' },
        { name => 'local',    url => 'C:/Users/John Doe/repo' },
    ], 'one fetch URL per remote, without credentials';

    is_deeply Devel::Cover::Report::Coveralls::parse_git_remotes(''), [], 'no remotes';
    is_deeply Devel::Cover::Report::Coveralls::parse_git_remotes(undef), [], 'git not available';
};

subtest 'get_git_info remotes' => sub {
    my $inside = `git rev-parse --is-inside-work-tree 2>&1`;
    plan skip_all => 'not in a git work tree' unless defined $inside && $inside =~ /^true/;

    my @names = split /\n/, `git remote`;
    my $got = Devel::Cover::Report::Coveralls::get_git_info();
    is_deeply [ map { $_->{name} } @{ $got->{remotes} } ], \@names, 'every remote, once each';
};

subtest 'git_log' => sub {
    my $inside = `git rev-parse --is-inside-work-tree 2>&1`;
    plan skip_all => 'not in a git work tree' unless defined $inside && $inside =~ /^true/;

    chomp(my $head = `git rev-parse HEAD`);
    is Devel::Cover::Report::Coveralls::git_log('%H'), $head, 'the commit ID, without quotes (Windows)';
    unlike Devel::Cover::Report::Coveralls::git_log('%ae'), qr/^'|'$/, 'no quotes around the e-mail address';
};

subtest 'get_source' => sub {
    my $source = {
        name => "$FindBin::Bin/example.pl",
        source => <<EOS,
#!/usr/bin/env perl
use strict;
use warnings;
use utf8;

print "hello, world";
EOS
        coverage => [undef, undef, undef, undef, undef, 0]
    };

    is_deeply Devel::Cover::Report::Coveralls::get_source("$FindBin::Bin/example.pl",
        sub { $_[0] == 6 ? 0 : undef } ), $source, 'source';
};

done_testing;