+ local @INC = @INC;
+ @INC = (\&fake_module)x2;
+ eval { require "${\'bralbalhablah'}" };
+ like $@, qr/^Can't locate/,
+ 'require PADTMP passing freed var when @INC has multiple subs';\r
+}
+
+SKIP: {
+ skip ("Not applicable when run from inccode-tie.t", 6) if tied @INC;
+ require Tie::Scalar;
+ package INCtie {
+ sub TIESCALAR { bless \my $foo }
+ sub FETCH { study; our $count++; ${$_[0]} }
+ }
+ local @INC = undef;
+ my $t = tie $INC[0], 'INCtie';
+ my $called;
+ $$t = sub { $called ++; !1 };
+ delete $INC{'foo.pm'}; # in case another test uses foo
+ eval { require foo };
+ is $INCtie::count, 2, # 2nd time for "Can't locate" -- XXX correct?
+ 'FETCH is called once on undef scalar-tied @INC elem';
+ is $called, 1, 'sub in scalar-tied @INC elem is called';
+ () = "$INC[0]"; # force a fetch, so the SV is ROK
+ $INCtie::count = 0;
+ eval { require foo };
+ is $INCtie::count, 2,
+ 'FETCH is called once on scalar-tied @INC elem holding ref';
+ is $called, 2, 'sub in scalar-tied @INC elem holding ref is called';
+ $$t = [];
+ $INCtie::count = 0;
+ eval { require foo };
+ is $INCtie::count, 1,
+ 'FETCH called once on scalar-tied @INC elem returning array';
+ $$t = "string";
+ $INCtie::count = 0;
+ eval { require foo };
+ is $INCtie::count, 2,
+ 'FETCH called once on scalar-tied @INC elem returning string';
+}
+
+
+exit if is_miniperl();
+
+SKIP: {
+ skip( "No PerlIO available", 3 ) unless $has_perlio;
+ pop @INC;
+
+ push @INC, sub {
+ my ($cr, $filename) = @_;
+ my $module = $filename; $module =~ s,/,::,g; $module =~ s/\.pm$//;
+ open my $fh, '<',
+ \"package $module; sub complain { warn q() }; \$::file = __FILE__;"
+ or die $!;
+ $INC{$filename} = "/custom/path/to/$filename";
+ return $fh;
+ };
+
+ require Publius::Vergilius::Maro;
+ is( $INC{'Publius/Vergilius/Maro.pm'},
+ '/custom/path/to/Publius/Vergilius/Maro.pm', '%INC set correctly');
+ is( our $file, '/custom/path/to/Publius/Vergilius/Maro.pm',
+ '__FILE__ set correctly' );
+ {
+ my $warning;
+ local $SIG{__WARN__} = sub { $warning = shift };
+ Publius::Vergilius::Maro::complain();
+ like( $warning, qr{something's wrong at /custom/path/to/Publius/Vergilius/Maro.pm}, 'warn() reports correct file source' );
+ }
+}
+pop @INC;
+
+if ($can_fork) {
+ require PerlIO::scalar;
+ # This little bundle of joy generates n more recursive use statements,
+ # with each module chaining the next one down to 0. If it works, then we
+ # can safely nest subprocesses
+ my $use_filter_too;
+ push @INC, sub {
+ return unless $_[1] =~ /^BBBLPLAST(\d+)\.pm/;
+ my $pid = open my $fh, "-|";
+ if ($pid) {
+ # Parent
+ return $fh unless $use_filter_too;
+ # Try filters and state in addition.
+ return ($fh, sub {s/$_[1]/pass/; return}, "die")
+ }
+ die "Can't fork self: $!" unless defined $pid;
+
+ # Child
+ my $count = $1;
+ # Lets force some fun with odd sized reads.
+ $| = 1;
+ print 'push @main::bbblplast, ';
+ print "$count;\n";
+ if ($count--) {
+ print "use BBBLPLAST$count;\n";
+ }
+ if ($use_filter_too) {
+ print "die('In $_[1]');";
+ } else {
+ print "pass('In $_[1]');";
+ }
+ print '"Truth"';
+ POSIX::_exit(0);
+ die "Can't get here: $!";
+ };
+
+ @::bbblplast = ();
+ require BBBLPLAST5;
+ is ("@::bbblplast", "0 1 2 3 4 5", "All ran");
+
+ foreach (keys %INC) {
+ delete $INC{$_} if /^BBBLPLAST/;
+ }
+
+ @::bbblplast = ();
+ $use_filter_too = 1;
+
+ require BBBLPLAST5;
+
+ is ("@::bbblplast", "0 1 2 3 4 5", "All ran with a filter");