This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add perldelta entry for 8a384d3a99 (ParseXS and locales).
[perl5.git] / t / op / inccode.t
index 0712956..016b425 100644 (file)
@@ -4,8 +4,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use Config;
@@ -21,7 +21,7 @@ unless (is_miniperl()) {
 
 use strict;
 
-plan(tests => 62 + !is_miniperl() * (3 + 14 * $can_fork));
+plan(tests => 68 + !is_miniperl() * (3 + 14 * $can_fork));
 
 sub get_temp_fh {
     my $f = tempfile();
@@ -280,6 +280,40 @@ sub fake_module {
         '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();