ext/CPANPLUS/t/25_CPANPLUS.t

   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