In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/36f064bc37569629cfa8ffed15497f849ae8ccfa?hp=56d86adf5b9b1c05ea2f24c084864c043d30d101>

- Log -----------------------------------------------------------------
commit 36f064bc37569629cfa8ffed15497f849ae8ccfa
Author: Christoph Lamprecht <[email protected]>
Date:   Mon May 11 14:00:11 2009 -0700

    do/require don't treat '.\foo' or '..\foo' as "absolute paths" on Windows.
    
    Both 'do' and 'require' treat paths *explicitly* relative to the
    current directory (starting with './' or '../') as a special form of
    absolute path.  That means they can be loaded directly and don't need
    to be resolved via @INC, so they don't rely on '.' being in @INC
    (unless running in taint mode). This behavior is "documented" in the P5P
    thread "Coderefs in @INC" from 2002.
    
    The code is missing special treatment of backslashes on Windows
    so that '.\\' and '..\\' are handled in the same manner.
    
    This change fixes
    
        http://rt.perl.org/rt3/Public/Bug/Display.html?id=63492
    
    (Note that the references to taint mode in the bug report are only
    relevant as far as taint mode removes '.' from @INC).
    
    This change also fixes the following Scalar-List-Utils bug report:
    
        http://rt.cpan.org/Public/Bug/Display.html?id=25430
    
    The Scalar::Util test failure in t/p_tainted.t only manifests itself
    under Test::Harness 3, and only outside the Perl core:
    
    * Test::Harness 2 (erroneously) puts '-I.' on the commandline in taint
      mode and runs something like this:
    
          `perl -I. t/p_tainted.t`
    
      so '.\t\tainted.t' can be found via '.' in @INC.
    
    * Core Perl runs something like this from the t/ directory:
    
          `..\perl.exe -I../lib ../ext/List-Util/t/p_tainted.t`
    
      so '.\..\ext\List-Util\t\tained.t' can be found via '../lib' in @INC.
    
    Signed-off-by: Jan Dubois <[email protected]>
-----------------------------------------------------------------------

Summary of changes:
 AUTHORS         |    1 +
 pp_ctl.c        |    8 ++++++++
 t/run/switcht.t |   22 +++++++++++++++++++++-
 3 files changed, 30 insertions(+), 1 deletions(-)

diff --git a/AUTHORS b/AUTHORS
index d25c432..3e508da 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -168,6 +168,7 @@ Chris Pepper
 Chris Wick                     <[email protected]>
 Christian Kirsch               <[email protected]>
 Christian Winter               <[email protected]>
+Christoph Lamprecht            <[email protected]>
 Christophe Grosjean            <[email protected]>
 Christopher Chan-Nui           <[email protected]>
 Christopher Davis              <[email protected]>
diff --git a/pp_ctl.c b/pp_ctl.c
index 27a4c03..dc8f0da 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4935,8 +4935,16 @@ S_path_is_absolute(const char *name)
     PERL_ARGS_ASSERT_PATH_IS_ABSOLUTE;
 
     if (PERL_FILE_IS_ABSOLUTE(name)
+#if WIN32
+       || (*name == '.' && ((name[1] == '/' ||
+                            (name[1] == '.' && name[2] == '/'))
+                        || (name[1] == '\\' ||
+                            ( name[1] == '.' && name[2] == '\\')))
+           )
+#else
        || (*name == '.' && (name[1] == '/' ||
                             (name[1] == '.' && name[2] == '/')))
+#endif
         )
     {
        return TRUE;
diff --git a/t/run/switcht.t b/t/run/switcht.t
index 564b2f3..6f0fed5 100644
--- a/t/run/switcht.t
+++ b/t/run/switcht.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 11;
+plan tests => 13;
 
 my $Perl = which_perl();
 
@@ -44,3 +44,23 @@ like( $warning, qr/^Insecure dependency in unlink $Tmsg/,
 ok( !-e $file,  'unlink worked' );
 
 ok( !$^W,   "-t doesn't enable regular warnings" );
+
+
+mkdir('tt');
+open(FH,'>','tt/ttest.pl')or DIE $!;
+print FH 'return 42';
+close FH or DIE $!;
+
+SKIP: {
+    ($^O eq 'MSWin32') || skip('skip tainted do test with \ seperator');
+    my $test = 0;
+    $test =  do '.\tt/ttest.pl';
+    is($test, 42, 'Could "do" .\tt/ttest.pl');
+}
+{
+    my $test = 0;
+    $test =  do './tt/ttest.pl';
+    is($test, 42, 'Could "do" ./tt/ttest.pl');
+}
+unlink ('./tt/ttest.pl');
+rmdir ('tt');

--
Perl5 Master Repository

Reply via email to