Commit | Line | Data |
4443dd53 |
1 | ### make sure we can find our conf.pl file |
2 | BEGIN { |
3 | use FindBin; |
4 | require "$FindBin::Bin/inc/conf.pl"; |
5 | } |
6 | |
7 | use strict; |
8 | use Test::More 'no_plan'; |
9 | use CPANPLUS::Error; |
10 | use CPANPLUS::Backend; |
11 | |
12 | my $Class = 'CPANPLUS'; |
13 | my $ModName = TEST_CONF_MODULE; |
14 | my $Conf = gimme_conf(); |
15 | my $CB = CPANPLUS::Backend->new( $Conf ); |
16 | |
17 | ### so we get an object with *our* configuration |
18 | no warnings 'redefine'; |
19 | local *CPANPLUS::Backend::new = sub { $CB }; |
20 | |
21 | use_ok( $Class ); |
22 | |
23 | ### install / get / fetch tests |
24 | for my $meth ( qw[fetch get install] ) { |
25 | my $sub = $Class->can( $meth ); |
26 | ok( $sub, "$Class->can( $meth )" ); |
27 | |
28 | my %map = ( |
29 | 0 => qr/failed/, |
30 | 1 => qr/successful/, |
31 | ); |
32 | |
33 | ok( 1, "Trying '$meth' in different configurations" ); |
34 | |
35 | while( my($rv, $re) = each %map ) { |
36 | |
37 | ### don't actually install, just test logic |
38 | no warnings 'redefine'; |
39 | local *CPANPLUS::Module::install = sub { $rv }; |
40 | local *CPANPLUS::Module::fetch = sub { $rv }; |
41 | |
42 | CPANPLUS::Error->flush; |
43 | |
44 | my $ok = $sub->( $ModName ); |
45 | is( $ok, $rv, " Expected RV: $rv" ); |
46 | like( CPANPLUS::Error->stack_as_string, $re, |
47 | " With expected diagnostic" ); |
48 | } |
49 | |
50 | ### does not take objects / references |
51 | { CPANPLUS::Error->flush; |
52 | |
53 | my $ok = $sub->( [] ); |
54 | ok( !$ok, "'$meth' with reference does not work" ); |
55 | like( CPANPLUS::Error->stack_as_string, qr/object/, |
56 | " Error as expected"); |
57 | } |
58 | |
59 | ### requires argument |
60 | { CPANPLUS::Error->flush; |
61 | |
62 | my $ok = $sub->( ); |
63 | ok( !$ok, "'$meth' without argument does not work" ); |
64 | like( CPANPLUS::Error->stack_as_string, qr/No module specified/, |
65 | " Error as expected"); |
66 | } |
67 | } |
68 | |
69 | ### shell tests |
70 | { my $meth = 'shell'; |
71 | my $sub = $Class->can( $meth ); |
72 | |
73 | ok( $sub, "$Class->can( $meth )" ); |
74 | |
75 | { ### test package for shell() method |
76 | package CPANPLUS::Shell::Test; |
77 | |
78 | ### ->shell() looks in %INC |
79 | use Module::Loaded qw[mark_as_loaded]; |
80 | mark_as_loaded( __PACKAGE__ ); |
81 | |
82 | sub new { bless {}, __PACKAGE__ }; |
83 | sub shell { $$ }; |
84 | } |
85 | |
86 | my $rv = $sub->( 'Test' ); |
87 | ok( $rv, " Shell started" ); |
88 | is( $rv, $$, " Proper shell called" ); |
89 | } |
90 | |