throw results from the CPAN

App-Fetchware


# CPAN modules making Fetchwarefile better.
use File::Temp 'tempdir';
use File::Spec::Functions qw(catfile rel2abs updir tmpdir);
use Test::More 0.98; # some utility test subroutines need it.
use Cwd;
use Archive::Tar;
use Path::Class;
use Digest::MD5;
use Fcntl qw(:flock :mode);
use Perl::OSType 'is_os_type';
use File::Temp 'tempfile';
use File::Path 'remove_tree';

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

# Enable Perl 6 knockoffs, and use 5.10.1, because smartmatching and other
# things in 5.10 were changed in 5.10.1+.
use 5.010001;


# Set up Exporter to bring App::Fetchware's API to everyone who use's it
# including fetchware's ability to let you rip into its guts, and customize it
# as you need.
use Exporter qw( import );
# By default fetchware exports its configuration file like subroutines and
# fetchware().
#

# These tags go with the override() subroutine, and together allow you to
# replace some or all of fetchware's default behavior to install unusual
# software.
our %EXPORT_TAGS = (
    TESTING => [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
    )],
);
# *All* entries in @EXPORT_TAGS must also be in @EXPORT_OK.
our @EXPORT_OK = map {@{$_}} values %EXPORT_TAGS;



sub eval_ok {
    my ($code, $expected_exception_text_or_regex, $test_name) = @_;
    eval {$code->()};
    # Test if an exception was actually thrown.
    if (not defined $@) {
        BAIL_OUT("[$test_name]'s provided code did not actually throw an exception");
    }
    
    # Support regexing the thrown exception's test if needed.
    if (ref $expected_exception_text_or_regex ne 'Regexp') {
        is($@, $expected_exception_text_or_regex, $test_name);
    } elsif (ref $expected_exception_text_or_regex eq 'Regexp') {
        like($@, qr/$expected_exception_text_or_regex/, $test_name);
    }

}



sub print_ok {
    my ($printer, $expected, $test_name) = @_;

    my $error;
    my $stdout;
    # Use eval to catch errors that $printer->() could possibly throw.
    eval {
        local *STDOUT;
        # Turn on Autoflush mode, so each time print is called it causes perl to
        # flush STDOUT's buffer. Otherwise a write could happen, that may not
        # actually get written before this eval closes, causing $stdout to stay
        # undef instead of getting whatever was written to STDOUT.
        $| = 1;
        open STDOUT, '>', \$stdout
            or $error = 'Can\'t open STDOUT to test cmd_upgrade using cmd_list';

        # Execute $printer
        $printer->();

        close STDOUT
            or $error = 'WTF! closing STDOUT actually failed! Huh?';
    } or do {
        $error = $@ if $@;
        fail($error) if defined $error;
    };

    # Since Test::More's testing subroutines return true or false if the test
    # passes or fails, return this true or false value back to the caller.
    if (ref($expected) eq '') {
        return is($stdout, $expected,
            $test_name);
    } elsif (ref($expected) eq 'Regexp') {
        return like($stdout, $expected,
            $test_name);
    } elsif (ref($expected) eq 'CODE') {
        # Call the provided callback with what $printer->() printed.
        return ok($expected->($stdout),
            $test_name);
    }
}



sub fork_ok {
    my $coderef = shift;
    my $test_name = shift;


    my $kid = fork;
    die "Couldn't fork: $!\n" if not defined $kid;
    # ... parent code here ...
    if ( $kid ) {
        # Block waiting for the child process ($kid) to exit.
        waitpid($kid, 0);
    }
    # ... child code here ...
    else {
        # Run caller's code wihtout any args.
        # And exit based on the success or failure of $coderef.
        $coderef->() ? exit 0 : exit 1;
    }

    # And test that the child returned successfully.
    ok(($? >> 8) == 0, $test_name);

    return $?;

lib/Test/Fetchware.pm view on Meta::CPAN

    print_ok(sub { some_func_that_prints()},

    sub { # a coderef that returns true of some_func_that_prints() printed what it
        #should print and returns false if it did not
        }, 'checked some_func_that_prints() printed matched coderefs expectations.');

    subtest 'some subtest that tests fetchware' => sub {
        skip_all_unless_release_testing();

        # ... Your tests go here that will be skipped unless
        # FETCHWARE_RELEASE_TESTING among other env vars are set properly.
    };

    make_clean();

    my $test_dist_path = make_test_dist(
        file_name => $file_name,
        ver_num = $ver_num,
        # These are all optional...
        destination_directory => rel2abs($destination_directory),
        fetchwarefile => $fetchwarefile,
        # You can only specify fetchwarefile *or* append_option.
        append_option => q{fetchware_option 'some value';},
        configure => <<EOF,
    #!/bin/sh

    # A test ./configure for testing ./configure failure...it always fails.

    echo "fetchware: ./configure failed!
    # Return failure exit status to truly indicate failure.
    exit 1
    EOF
        makefile => <<EOF,
    # Test Makefile.
    all:
        sh -c 'echo "fetchware make failed!"'
    EOF
    );

    my $md5sum_fil_path = md5sum_file($archive_to_md5);


    my $expected_filename_listing = expected_filename_listing()

=head1 DESCRIPTION

These subroutines provide miscellaneous subroutines that App::Fetchware's test
suite uses. Some are quite specific such as make_test_dist(), while others are
simple subroutines replacing entire CPAN modules such as eval_ok (similar to
Test::Exception) and print_ok (similar to Test::Output). I wrote them instead of
using the CPAN dependency, because all it would take is a relatively simple
function that I could easily write and test. And their interfaces disagreed with
me. 

=head1 TESTING SUBROUTINES

=head2 eval_ok()

    eval_ok($code, $expected_exception_text_or_regex, $test_name);

Executes the $code coderef, and compares its thrown exception, C<$@>, to
$expected_exception_text_or_regex, and uses $test_name as the name for the test if
provided.

If $expected_exception_text_or_regex is a string then Test::More's is() is used,
and if $expected_exception_text_or_regex is a C<'Regexp'> according to ref(),
then like() is used, which will treat $expected_exception_text_or_regex as a
regex instead of as just a string.

=head2 print_ok()

    print_ok(\&printer, $expected, $test_name);

Tests if $expected is in the output that C<\&printer-E<gt>()> produces on C<STDOUT>.

It passes $test_name along to the underlying L<Test::More> function that it uses
to do the test.

$expected can be a C<SCALAR>, C<Regexp>, or C<CODEREF> as returned by Perl's
L<ref()> function.

=over

=item * If $expected is a SCALAR according to ref()

=over

=item * Then Use eq to determine if the test passes.

=back

=item * If $expected is a Regexp according to ref()

=over

=item * Then use a regex comparision just like Test::More's like() function.

=back

=item * If $expected is a CODEREF according to ref()

=over

=item * Then execute the coderef with a copy of the $printer's STDOUT and use the result of that expression to determine if the test passed or failed .

=back

=back

=over

NOTICE: C<print_ok()'s> manipuation of STDOUT only works for the current Perl
process. STDOUT may be inherited by forks, but for some reason my knowledge of
Perl and Unix lacks a better explanation other than that print_ok() does not
work for testing what C<fork()ed> and C<exec()ed> processes do such as those
executed with run_prog().

I also have not tested other possibilities, such as using IO::Handle to
manipulate STDOUT, or tie()ing STDOUT like Test::Output does. These methods
probably would not survive a fork() and an exec() though either.

lib/Test/Fetchware.pm view on Meta::CPAN


Writes the provided $fetchwarefile_content to a C<Fetchwarefile> inside a
File::Temp::tempfile(), and returns that file's path, $fetchwarefile_path.

=head2 rmdashr_ok()

    rmdashr_ok($dir_to_recursive_delete, $test_message)

Recursively deletes the specified directory using L<File::Path>'s remove_tree()
subroutine. Returns nothing, but does call L<Test::More>'s ok() for you with
your $test_message if remove_tree() was successful.

=over

=item NOTE:

rmdashr_ok() reports its test as PASS if I<any> number of files are successfully
deleted. It only reports FAIL if I<no> directories were deleted. L<Test::More>'s
note() is used to print out verbose info about exactly what files were deleted,
any errors, and number or errors/warnings and successfully deleted files are
printed using note(), which only shows the output if prove(1)'s C<-v> switch is
used.

=back

=head1 ERRORS

As with the rest of App::Fetchware, Test::Fetchware does not return any error
codes; instead, all errors are die()'d if it's Test::Fetchware's error, or
croak()'d if its the caller's fault. These exceptions are simple strings, and
usually more than just one line long to help further describe the problem to
make fixing it easier.

=head1 SEE ALSO

L<Test::Exception> is similar to Test::Fetchware's eval_ok().

L<Test::Output> is similar to Test::Fetchware's print_ok().

=head1 AUTHOR

David Yingling <deeelwy@gmail.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2016 by David Yingling.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut

__END__





##TODO##=head1 DIAGNOSTICS
##TODO##
##TODO##App::Fetchware throws many exceptions. These exceptions are not listed below,
##TODO##because I have not yet added additional information explaining them. This is
##TODO##because fetchware throws very verbose error messages that don't need extra
##TODO##explanation. This section is reserved for when I have to actually add further
##TODO##information regarding one of these exceptions.
##TODO##
##TODO##=cut

( run in 1.733 second using v1.01-cache-2.11-cpan-140bd7fdf52 )