lib/CPANPLUS/t/00_CPANPLUS-Inc.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
  10 my $Class = 'CPANPLUS::inc';
  11 use_ok( $Class );
  12 can_ok( $Class, qw[original_perl5opt original_perl5lib original_inc] );
  13
  14 __END__
  15
  16 # XXX CPANPLUS::inc functionality is obsolete, so it is removed
  17
  18 my $Module = 'Params::Check';
  19 my $File   = File::Spec->catfile(qw|Params Check.pm|);
  20 my $Ufile  = 'Params/Check.pm';
  21 my $Boring = 'IO::File';
  22 my $Bfile  = 'IO/File.pm';
  23
  24
  25
  26 ### now, first element should be a coderef ###
  27 my $code = $INC[0];
  28 is( ref $code, 'CODE',          'Coderef loaded in @INC' );
  29
  30 ### check interesting modules ###
  31 {   my $mods = CPANPLUS::inc->interesting_modules();
  32     ok( $mods,                  "Retrieved interesting modules list" );
  33     is( ref $mods, 'HASH',      "   It's a hashref" );
  34     ok( scalar(keys %$mods),    "   With some keys in it" );
  35     ok( $mods->{$Module},       "   Found a module we care about" );
  36 }
  37
  38 ### checking include path ###
  39 SKIP: {
  40     my $path = CPANPLUS::inc->inc_path();
  41     ok( $path,                  "Retrieved include path" );
  42     ok( -d $path,               "   Include path is an actual directory" );
  43
  44     ### XXX no more files are bundled this way, it's obsolete
  45     #skip "No files actually bundled in perl core", 1 if $ENV{PERL_CORE};
  46     #ok( -s File::Spec->catfile( $path, $File ),
  47     #                            "   Found '$File' in include path" );
  48
  49     ### we don't do this anymore
  50     #my $out = join '', `$^X -V`; my $qm_path = quotemeta $path;
  51     #like( $out, qr/$qm_path/s,  "   Path found in perl -V output" );
  52 }
  53
  54 ### back to the coderef ###
  55 ### try a boring module ###
  56 {   local $CPANPLUS::inc::DEBUG = 1;
  57     my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" };
  58
  59     my $rv = $code->($code, $Bfile);
  60     ok( !$rv,                   "Ignoring boring module" );
  61     ok( !$INC{$Bfile},          "   Boring file not loaded" );
  62     like( $warnings, qr/CPANPLUS::inc: Not interested in '$Boring'/s,
  63                                 "   Warned about boringness" );
  64 }
  65
  66 ### try to load a module with windows paths in it (bug [#11177])
  67 {   local $CPANPLUS::inc::DEBUG = 1;
  68     my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" };
  69
  70     my $wfile   = 'IO\File.pm';
  71     my $wmod    = 'IO::File';
  72
  73     my $rv = $code->($code, $wfile);
  74     ok( !$rv,                   "Ignoring boring win32 module" );
  75     ok( !$INC{$wfile},          "   Boring win32 file not loaded" );
  76     like( $warnings, qr/CPANPLUS::inc: Not interested in '$wmod'/s,
  77                                 "   Warned about boringness" );
  78 }
  79
  80 ### try an interesting module ###
  81 {   local $CPANPLUS::inc::DEBUG = 1;
  82     my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" };
  83
  84     my $rv = $code->($code, $Ufile);
  85     ok( $rv,                    "Found interesting module" );
  86     ok( !$INC{$Ufile},          "   Interesting file not loaded" );
  87     like( $warnings, qr/CPANPLUS::inc: Found match for '$Module'/,
  88                                 "   Match noted in warnings" );
  89     like( $warnings, qr/CPANPLUS::inc: Best match for '$Module'/,
  90                                 "   Best match noted in warnings" );
  91
  92     my $contents = do { local $/; <$rv> };
  93     ok( $contents,              "   Read contents from filehandle" );
  94     like( $contents, qr/$Module/s,
  95                                 "   Contents is from '$Module'" );
  96 }
  97
  98 ### now do some real loading ###
  99 {   use_ok($Module);
 100     ok( $INC{$Ufile},           "   Regular use of '$Module'" );
 101
 102     use_ok($Boring);
 103     ok( $INC{$Bfile},           "   Regular use of '$Boring'" );
 104 }
 105
 106 ### check we didn't load our coderef anymore than needed ###
 107 {   my $amount = 5;
 108     for( 0..$amount ) { CPANPLUS::inc->import; };
 109
 110     my $flag;
 111     map { $flag++ if ref $_ eq 'CODE' } @INC[0..$amount];
 112
 113     my $ok = $amount + 1 == $flag ? 0 : 1;
 114     ok( $ok,                    "Only loaded coderef into \@INC $flag times");
 115 }
 116
 117 ### check limit funcionality
 118 {   local $CPANPLUS::inc::DEBUG = 1;
 119     my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" };
 120
 121     ### so we can reload it
 122     delete $INC{$Ufile};
 123     delete $INC{$Bfile};
 124
 125     ### limit to the loading of $Boring;
 126     CPANPLUS::inc->import( $Boring );
 127
 128     ok( $CPANPLUS::inc::LIMIT{$Boring},
 129                                 "Limit to '$Boring' recorded" );
 130
 131     ### try a boring file first
 132     {   my $rv = $code->($code, $Bfile);
 133         ok( !$rv,               "   '$Boring' still not being loaded" );
 134         ok( !$INC{$Bfile},      '   Is not in %INC either' );
 135     }
 136
 137     ### try an interesting one now
 138     {   my $rv = $code->( $code, $Ufile );
 139         ok( !$rv,               "   '$Module' is not being loaded" );
 140         ok( !$INC{$Ufile},      '   Is not in %INC either' );
 141         like( $warnings, qr/CPANPLUS::inc: Limits active, '$Module'/s,
 142                                 "   Warned about limits" );
 143     }
 144
 145     ### reset limits, try again
 146     {   local %CPANPLUS::inc::LIMIT;
 147         ok( !keys(%CPANPLUS::inc::LIMIT),
 148                                 "   Limits removed" );
 149
 150
 151         my $rv = $code->( $code, $Ufile );
 152         ok( $rv,                "   '$Module' is being loaded" );
 153
 154         use_ok( $Module );
 155         ok( $INC{$Ufile},       '   Present in %INC' );
 156     }
 157 }
 158
 159 ### test limited perl5opt, to include just a few modules
 160 {   my $dash_m  = quotemeta '-MCPANPLUS::inc';
 161     my $dash_i  = quotemeta '-I' . CPANPLUS::inc->my_path;
 162     my $orgopt  = quotemeta CPANPLUS::inc->original_perl5opt;
 163
 164     ### first try an empty string;
 165     {   my $str = CPANPLUS::inc->limited_perl5opt;
 166         ok( !$str,              "limited_perl5opt without args is empty" );
 167     }
 168
 169     ### try with one 'modules'
 170     {   my $str = CPANPLUS::inc->limited_perl5opt(qw[A]);
 171         ok( $str,               "limted perl5opt set for 1 module" );
 172         like( $str, qr/$dash_m=A\b/,
 173                                 "   -M set properly" );
 174         like( $str, qr/$dash_i/,"   -I set properly" );
 175         like( $str, qr/$orgopt/,"   Original opts preserved" );
 176     }
 177
 178     ### try with more 'modules'
 179     {   my $str = CPANPLUS::inc->limited_perl5opt(qw[A B C]);
 180         ok( $str,               "limted perl5opt set for 3 modules" );
 181         like( $str, qr/$dash_m=A,B,C\b/,
 182                                 "   -M set properly" );
 183         like( $str, qr/$dash_i/,"   -I set properly" );
 184         like( $str, qr/$orgopt/,"   Original opts preserved" );
 185     }
 186 }
 187
 188
 189
 190