t/op/inccode.t

   1 #!./perl -w
   2
   3 # Tests for the coderef-in-@INC feature
   4
   5 BEGIN {
   6   chdir 't' if -d 't';
   7   @INC = '../lib';
   8 }
   9 use Config;
  10 unless ($Config{useperlio}) {
  11   print "1..0 # Skipping (tests are implemented using perlio features, this perl uses stdio)\n";
  12   exit 0;
  13 }
  14
  15 print "1..12\n";
  16
  17 sub fooinc {
  18     my ($self, $filename) = @_;
  19     if (substr($filename,0,3) eq 'Foo') {
  20         open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;");
  21         return $fh;
  22     }
  23     else {
  24         return undef;
  25     }
  26 }
  27
  28 push @INC, \&fooinc;
  29
  30 print "not " if eval { require Bar };
  31 print "ok 1\n";
  32 print "not " if ! eval { require Foo }  or ! exists $INC{'Foo.pm'};
  33 print "ok 2\n";
  34 print "not " if ! eval "use Foo1; 1;"   or ! exists $INC{'Foo1.pm'};
  35 print "ok 3\n";
  36 print "not " if ! eval { do 'Foo2.pl' } or ! exists $INC{'Foo2.pl'};
  37 print "ok 4\n";
  38
  39 pop @INC;
  40
  41 sub fooinc2 {
  42     my ($self, $filename) = @_;
  43     if (substr($filename, 0, length($self->[1])) eq $self->[1]) {
  44         open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;");
  45         return $fh;
  46     }
  47     else {
  48         return undef;
  49     }
  50 }
  51
  52 push @INC, [ \&fooinc2, 'Bar' ];
  53
  54 print "not " if ! eval { require Foo }; # Already loaded
  55 print "ok 5\n";
  56 print "not " if eval { require Foo3 };
  57 print "ok 6\n";
  58 print "not " if ! eval { require Bar }  or ! exists $INC{'Bar.pm'};
  59 print "ok 7\n";
  60 print "not " if ! eval "use Bar1; 1;"   or ! exists $INC{'Bar1.pm'};
  61 print "ok 8\n";
  62 print "not " if ! eval { do 'Bar2.pl' } or ! exists $INC{'Bar2.pl'};
  63 print "ok 9\n";
  64
  65 pop @INC;
  66
  67 sub FooLoader::INC {
  68     my ($self, $filename) = @_;
  69     if (substr($filename,0,4) eq 'Quux') {
  70         open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;");
  71         return $fh;
  72     }
  73     else {
  74         return undef;
  75     }
  76 }
  77
  78 push @INC, bless( {}, 'FooLoader' );
  79
  80 print "not " if ! eval { require Quux } or ! exists $INC{'Quux.pm'};
  81 print "ok 10\n";
  82
  83 pop @INC;
  84
  85 push @INC, bless( [], 'FooLoader' );
  86
  87 print "not " if ! eval { require Quux1 } or ! exists $INC{'Quux1.pm'};
  88 print "ok 11\n";
  89
  90 pop @INC;
  91
  92 push @INC, bless( \(my $x = 1), 'FooLoader' );
  93
  94 print "not " if ! eval { require Quux2 } or ! exists $INC{'Quux2.pm'};
  95 print "ok 12\n";