t/op/inccode.t

   1 #!./perl -wT
   2
   3 # Tests for the coderef-in-@INC feature
   4
   5 BEGIN {
   6     chdir 't' if -d 't';
   7     @INC = '../lib';
   8 }
   9
  10 use Config;
  11
  12 BEGIN {
  13     require Test::More;
  14
  15     # This test relies on perlio, but the feature being tested does not.
  16     # The dependency should eventually be purged and use something like
  17     # Tie::Handle instead.
  18     if( $Config{useperlio} ) {
  19         Test::More->import(tests => 21);
  20     }
  21     else {
  22         Test::More->import('skip_all');
  23     }
  24 }
  25
  26 sub fooinc {
  27     my ($self, $filename) = @_;
  28     if (substr($filename,0,3) eq 'Foo') {
  29         open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;");
  30         return $fh;
  31     }
  32     else {
  33         return undef;
  34     }
  35 }
  36
  37 push @INC, \&fooinc;
  38
  39 ok( !eval { require Bar; 1 },      'Trying non-magic package' );
  40
  41 ok( eval { require Foo; 1 },       'require() magic via code ref'  );
  42 ok( exists $INC{'Foo.pm'},         '  %INC sees it' );
  43
  44 ok( eval "use Foo1; 1;",           'use()' );
  45 ok( exists $INC{'Foo1.pm'},        '  %INC sees it' );
  46
  47 ok( eval { do 'Foo2.pl'; 1 },      'do()' );
  48 ok( exists $INC{'Foo2.pl'},        '  %INC sees it' );
  49
  50 pop @INC;
  51
  52
  53 sub fooinc2 {
  54     my ($self, $filename) = @_;
  55     if (substr($filename, 0, length($self->[1])) eq $self->[1]) {
  56         open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;");
  57         return $fh;
  58     }
  59     else {
  60         return undef;
  61     }
  62 }
  63
  64 push @INC, [ \&fooinc2, 'Bar' ];
  65
  66 ok( eval { require Foo; 1; },     'Originally loaded packages preserved' );
  67 ok( !eval { require Foo3; 1; },   'Original magic INC purged' );
  68
  69 ok( eval { require Bar; 1 },      'require() magic via array ref' );
  70 ok( exists $INC{'Bar.pm'},        '  %INC sees it' );
  71
  72 ok( eval "use Bar1; 1;",          'use()' );
  73 ok( exists $INC{'Bar1.pm'},       '  %INC sees it' );
  74
  75 ok( eval { do 'Bar2.pl'; 1 },     'do()' );
  76 ok( exists $INC{'Bar2.pl'},       '  %INC sees it' );
  77
  78 pop @INC;
  79
  80 sub FooLoader::INC {
  81     my ($self, $filename) = @_;
  82     if (substr($filename,0,4) eq 'Quux') {
  83         open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;");
  84         return $fh;
  85     }
  86     else {
  87         return undef;
  88     }
  89 }
  90
  91 push @INC, bless( {}, 'FooLoader' );
  92
  93 ok( eval { require Quux; 1 },      'require() magic via hash object' );
  94 ok( exists $INC{'Quux.pm'},        '  %INC sees it' );
  95
  96 pop @INC;
  97
  98 push @INC, bless( [], 'FooLoader' );
  99
 100 ok( eval { require Quux1; 1 },     'require() magic via array object' );
 101 ok( exists $INC{'Quux1.pm'},       '  %INC sees it' );
 102
 103 pop @INC;
 104
 105 push @INC, bless( \(my $x = 1), 'FooLoader' );
 106
 107 ok( eval { require Quux2; 1 },     'require() magic via scalar object' );
 108 ok( exists $INC{'Quux2.pm'},       '  %INC sees it' );
 109
 110 pop @INC;