view release on metacpan or  search on metacpan

t/Test-Fetchware.t  view on Meta::CPAN

use File::Temp qw(tempdir tempfile);
use File::Path qw(remove_tree make_path);

use App::Fetchware::Config ':CONFIG';

# Set PATH to a known good value.
$ENV{PATH} = '/usr/local/bin:/usr/bin:/bin';
# Delete *bad* elements from environment to make it safer as recommended by
# perlsec.
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};

# Test if I can load the module "inside a BEGIN block so its functions are exported
# and compile-time, and prototypes are properly honored."
# There is no ':OVERRIDE_START' to bother importing.
BEGIN { use_ok('Test::Fetchware', ':TESTING'); }

# Print the subroutines that App::Fetchware imported by default when I used it.
note("App::Fetchware's default imports [@Test::Fetchware::EXPORT_OK]");


# make_test_dist()'s test need access to bin/fetchware's cmd_install() to
# actually fully test it, so import it as bin/fetchware's own test suite does.
BEGIN {
    my $fetchware = 'fetchware';
    use lib 'bin';
    require $fetchware;
    fetchware->import(':TESTING');
    ok(defined $INC{$fetchware}, 'checked bin/fetchware loading and import')
}



###BUGALERT### Add tests for :TESTING subs that have no tests!!!
subtest 'TESTING export what they should' => sub {
    my @expected_testing_exports = qw(
        eval_ok
        print_ok
        fork_ok
        fork_not_ok
        skip_all_unless_release_testing
        make_clean
        make_test_dist
        md5sum_file
        expected_filename_listing
        verbose_on
        export_ok
        end_ok
        add_prefix_if_nonroot
        create_test_fetchwarefile
        rmdashr_ok
    );
    # sort them to make the testing their equality very easy.
    @expected_testing_exports = sort @expected_testing_exports;
    my @sorted_testing_tag = sort @{$Test::Fetchware::EXPORT_TAGS{TESTING}};
    is_deeply(\@sorted_testing_tag, \@expected_testing_exports,
        'checked for correct exports.');
};


subtest 'test print_ok()' => sub {
    # Can't easily test the exceptions print_ok() throws, because they're if
    # open()ing a scalar ref fails, and if calling close() actually failes,
    # which can't easily be forced to fail.

    # Test print_ok() string message.
    my $test_message = 'A test message';
    print_ok(sub {print $test_message},
        $test_message, 'checked print_ok() string message success');

    # Test print_ok() regex.
    print_ok(sub {print $test_message},
        qr/$test_message/, 'checked print_ok() regex message success');

    print_ok(sub {print $test_message},
        sub {return 1 if $_[0] eq $test_message; return;},
        'checked print_ok() simple coderef success');
};


subtest 'test make_test_dist()' => sub {
    ###HOWTOTEST### How do I test for mkdir() failure, open() failure, and
    #Archive::Tar->create_archive() failure?

    my $file_name = 'test-dist';
    my $ver_num = '1.00';
    my $retval = make_test_dist(file_name => $file_name, ver_num => $ver_num);
    is(file($retval)->basename(), "$file_name-$ver_num.fpkg",
        'check make_test_dist() success.');
    ok(-e $retval, 'check make_test_dist() existence.');

    ok(unlink $retval, 'checked make_test_dist() cleanup');

    # Test more than one call as used in t/bin-fetchware-upgrade-all.t
    my @filenames = qw(test-dist another-dist);

    my @retvals;
    for my $filename (@filenames) {
        my $retval = make_test_dist(file_name => $file_name, ver_num => $ver_num);
        is(file($retval)->basename(), "$file_name-$ver_num.fpkg",
            'check make_test_dist() 2 calls  success.');
        ok(-e $retval, 'check make_test_dist() 2 calls existence.');
        push @retvals, $retval;
    }

    ok(unlink @retvals, 'checked make_test_dist() 2 calls cleanup');

    # Test make_test_dist()'s second destination directory argument.
    my $name = 'test-dist';
    my $return_val = make_test_dist(file_name => $file_name, ver_num => $ver_num,
        destination_directory => 't');
    is($return_val, rel2abs(catfile('t', "$name-$ver_num.fpkg")),
        'check make_test_dist() destination directory success.');
    ok(-e $return_val, 'check make_test_dist() destination directory existence.');

    ok(unlink $return_val, 'checked make_test_dist() cleanup');


    # Test make_test_dist()'s second destination directory argument in a
    # temp_dir.
    my $name2 = 'test-dist';
    my $rv = make_test_dist(file_name => $name2, ver_num => $ver_num,