view release on metacpan or  search on metacpan

t/02_CPANPLUS-Internals.t  view on Meta::CPAN

    is( $cb->_host_ok( host => $host ),     0,  "   Host still bad" );
    ok( $cb->_flush( list => ['hosts'] ),       "   Hosts flushed" );
    is( $cb->_host_ok( host => $host ),     1,  "   Host now ok again" );
}

### flush loads test
{   my $mod     = 'Benchmark';
    my $file    = $mod . '.pm';

    ### XXX whitebox test -- mark this module as unloadable
    $Module::Load::Conditional::CACHE->{$mod}->{usable} = 0;

    ok( !can_load( modules => { $mod => 0 }, verbose => 0 ),
                                                "'$mod' not loaded" );

    ok( $cb->flush('load'),                     "   'load' cache flushed" );
    ok( can_load( modules => { $mod => 0 }, verbose => 0 ),
                                                "   '$mod' loaded" );
}

### add to inc path tests
{   my $meth = '_add_to_includepath';
    can_ok( $cb,                $meth );

    my $p5lib   = $ENV{PERL5LIB} || '';
    my $inc     = "@INC";
    ok( $cb->$meth( directories => [$$] ),
                                "   CB->$meth( $$ )" );

    my $new_p5lib   = $ENV{PERL5LIB};
    my $new_inc     = "@INC";
    isnt( $p5lib, $new_p5lib,   "       PERL5LIB is now: $new_p5lib" );
    like( $new_p5lib, qr/$$/,   "           Matches $$" );

    isnt( $inc, $new_inc,       '       @INC is expanded with: ' . $$ );
    like( $new_inc, qr/$$/,     "           Matches $$" );

    ok( $cb->$meth( directories => [$$] ),
                                "       CB->$meth( $$ ) again" );
    is( "@INC", $new_inc,       '           @INC unchanged' );
    is( $new_p5lib, $ENV{PERL5LIB},
                                "           PERL5LIB unchanged" );
}

### callback registering tests ###
{    my $callback_map = {
        ### name                default value
        install_prerequisite    => 1,   # install prereqs when 'ask' is set?
        edit_test_report        => 0,   # edit the prepared test report?
        send_test_report        => 1,   # send the test report?
        munge_test_report       => $$,  # munge the test report
        filter_prereqs          => $$,  # limit prereqs
        proceed_on_test_failure => 0,   # continue on failed 'make test'?
        munge_dist_metafile     => $$,  # munge the metailfe
    };

    for my $callback ( keys %$callback_map ) {

        {   my $rv = $callback_map->{$callback};

            is( $rv, $cb->_callbacks->$callback->( $0, $$ ),
                                "Default callback '$callback' called" );
            like( CPANPLUS::Error->stack_as_string, qr/DEFAULT '\S+' HANDLER/s,
                                "   Default handler warning recorded" );
            CPANPLUS::Error->flush;
        }

        ### try to register the callback
        my $ok = $cb->_register_callback(
                        name    => $callback,
                        code    => sub { return $callback }
                    );

        ok( $ok,                "Registered callback '$callback' ok" );

        my $sub = $cb->_callbacks->$callback;
        ok( $sub,               "   Retrieved callback" );
        ok( IS_CODEREF->($sub), "   Callback is a sub" );

        my $rv = $sub->();
        ok( $rv,                "   Callback called ok" );
        is( $rv, $callback,     "   Got expected return value" );
    }
}


# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4: