Change 33114 by [EMAIL PROTECTED] on 2008/01/29 23:06:17
Integrate:
[ 32710]
The ext/Cwd/Cwd.xs part of...
Subject: consting Cwd and ExtUtils::ParseXS
From: "Robin Barker" <[EMAIL PROTECTED]>
Date: Sat, 22 Dec 2007 00:52:54 -0000
Message-ID: <[EMAIL PROTECTED]>
lib/ExtUtils/ParseXS.pm had changes already made with change
#32691.
[ 33042]
Upgrade to PathTools-3.27
Affected files ...
... //depot/maint-5.10/perl/ext/Cwd/Cwd.xs#2 integrate
... //depot/maint-5.10/perl/ext/Cwd/t/cwd.t#2 integrate
... //depot/maint-5.10/perl/lib/Cwd.pm#2 integrate
... //depot/maint-5.10/perl/lib/File/Spec.pm#2 integrate
... //depot/maint-5.10/perl/lib/File/Spec/Cygwin.pm#2 integrate
... //depot/maint-5.10/perl/lib/File/Spec/Epoc.pm#2 integrate
... //depot/maint-5.10/perl/lib/File/Spec/Functions.pm#2 integrate
... //depot/maint-5.10/perl/lib/File/Spec/Mac.pm#2 integrate
... //depot/maint-5.10/perl/lib/File/Spec/OS2.pm#2 integrate
... //depot/maint-5.10/perl/lib/File/Spec/Unix.pm#2 integrate
... //depot/maint-5.10/perl/lib/File/Spec/VMS.pm#2 integrate
... //depot/maint-5.10/perl/lib/File/Spec/Win32.pm#2 integrate
... //depot/maint-5.10/perl/lib/File/Spec/t/Spec.t#2 integrate
... //depot/maint-5.10/perl/lib/File/Spec/t/crossplatform.t#2 integrate
... //depot/maint-5.10/perl/lib/File/Spec/t/tmpdir.t#2 integrate
Differences ...
==== //depot/maint-5.10/perl/ext/Cwd/Cwd.xs#2 (text) ====
Index: perl/ext/Cwd/Cwd.xs
--- perl/ext/Cwd/Cwd.xs#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/Cwd/Cwd.xs 2008-01-29 15:06:17.000000000 -0800
@@ -2,7 +2,8 @@
#include "perl.h"
#include "XSUB.h"
#ifndef NO_PPPORT_H
-# define NEED_sv_2pv_nolen
+# define NEED_my_strlcpy
+# define NEED_my_strlcat
# include "ppport.h"
#endif
@@ -10,9 +11,8 @@
# include <unistd.h>
#endif
-/* The realpath() implementation from OpenBSD 2.9 (realpath.c 1.4)
+/* The realpath() implementation from OpenBSD 3.9 to 4.2 (realpath.c 1.13)
* Renamed here to bsd_realpath() to avoid library conflicts.
- * --jhi 2000-06-20
*/
/* See
@@ -22,11 +22,7 @@
*/
/*
- * Copyright (c) 1994
- * The Regents of the University of California. All rights reserved.
- *
- * This code is derived from software contributed to Berkeley by
- * Jan-Simon Pendry.
+ * Copyright (c) 2003 Constantin S. Svintsoff <[EMAIL PROTECTED]>
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
@@ -36,14 +32,14 @@
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
- * 3. Neither the name of the University nor the names of its contributors
- * may be used to endorse or promote products derived from this software
- * without specific prior written permission.
+ * 3. The names of the authors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
*
- * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
@@ -53,10 +49,6 @@
* SUCH DAMAGE.
*/
-#if defined(LIBC_SCCS) && !defined(lint)
-static char *rcsid = "$OpenBSD: realpath.c,v 1.4 1998/05/18 09:55:19 deraadt
Exp $";
-#endif /* LIBC_SCCS and not lint */
-
/* OpenBSD system #includes removed since the Perl ones should do. --jhi */
#ifndef MAXSYMLINKS
@@ -64,7 +56,7 @@
#endif
/*
- * char *realpath(const char *path, char resolved_path[MAXPATHLEN]);
+ * char *realpath(const char *path, char resolved[MAXPATHLEN]);
*
* Find the real name of path, by removing all ".", ".." and symlink
* components. Returns (resolved) on success, or (NULL) on failure,
@@ -79,7 +71,8 @@
return Perl_rmsexpand(aTHX_ (char*)path, resolved, NULL, 0);
#else
int rootd, serrno;
- char *p, *q, wbuf[MAXPATHLEN];
+ const char *p;
+ char *q, wbuf[MAXPATHLEN];
int symlinks = 0;
/* Save the starting point. */
@@ -112,17 +105,18 @@
loop:
q = strrchr(resolved, '/');
if (q != NULL) {
+ const char *dir;
p = q + 1;
if (q == resolved)
- q = "/";
+ dir = "/";
else {
do {
--q;
} while (q > resolved && *q == '/');
q[1] = '\0';
- q = resolved;
+ dir = resolved;
}
- if (chdir(q) < 0)
+ if (chdir(dir) < 0)
goto err1;
} else
p = resolved;
==== //depot/maint-5.10/perl/ext/Cwd/t/cwd.t#2 (text) ====
Index: perl/ext/Cwd/t/cwd.t
--- perl/ext/Cwd/t/cwd.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/Cwd/t/cwd.t 2008-01-29 15:06:17.000000000 -0800
@@ -135,16 +135,11 @@
# Cwd::chdir should also update $ENV{PWD}
dir_ends_with( $ENV{PWD}, $Test_Dir, 'Cwd::chdir() updates $ENV{PWD}' );
my $updir = File::Spec->updir;
-Cwd::chdir $updir;
-print "#$ENV{PWD}\n";
-Cwd::chdir $updir;
-print "#$ENV{PWD}\n";
-Cwd::chdir $updir;
-print "#$ENV{PWD}\n";
-Cwd::chdir $updir;
-print "#$ENV{PWD}\n";
-Cwd::chdir $updir;
-print "#$ENV{PWD}\n";
+
+for ([EMAIL PROTECTED]) {
+ Cwd::chdir $updir;
+ print "#$ENV{PWD}\n";
+}
rmtree($test_dirs[0], 0, 0);
==== //depot/maint-5.10/perl/lib/Cwd.pm#2 (text) ====
Index: perl/lib/Cwd.pm
--- perl/lib/Cwd.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/Cwd.pm 2008-01-29 15:06:17.000000000 -0800
@@ -171,7 +171,7 @@
use Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
-$VERSION = '3.2501';
+$VERSION = '3.27';
@ISA = qw/ Exporter /;
@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
@@ -540,8 +540,8 @@
local *PARENT;
unless (opendir(PARENT, $dotdots))
{
- _carp("opendir($dotdots): $!");
- return '';
+ # probably a permissions issue. Try the native command.
+ return File::Spec->rel2abs( $start, _backtick_pwd() );
}
unless (@cst = stat($dotdots))
{
@@ -653,6 +653,25 @@
return _vms_abs_path($link_target);
}
+ if (defined &VMS::Filespec::vms_realpath) {
+ my $path = $_[0];
+ if ($path =~ m#(?<=\^)/# ) {
+ # Unix format
+ return VMS::Filespec::vms_realpath($path);
+ }
+
+ # VMS format
+
+ my $new_path = VMS::Filespec::vms_realname($path);
+
+ # Perl expects directories to be in directory format
+ $new_path = VMS::Filespec::pathify($new_path) if -d $path;
+ return $new_path;
+ }
+
+ # Fallback to older algorithm if correct ones are not
+ # available.
+
# may need to turn foo.dir into [.foo]
my $pathified = VMS::Filespec::pathify($path);
$path = $pathified if defined $pathified;
==== //depot/maint-5.10/perl/lib/File/Spec.pm#2 (text) ====
Index: perl/lib/File/Spec.pm
--- perl/lib/File/Spec.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/File/Spec.pm 2008-01-29 15:06:17.000000000 -0800
@@ -3,7 +3,7 @@
use strict;
use vars qw(@ISA $VERSION);
-$VERSION = '3.2501';
+$VERSION = '3.27';
$VERSION = eval $VERSION;
my %module = (MacOS => 'Mac',
==== //depot/maint-5.10/perl/lib/File/Spec/Cygwin.pm#2 (text) ====
Index: perl/lib/File/Spec/Cygwin.pm
--- perl/lib/File/Spec/Cygwin.pm#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/lib/File/Spec/Cygwin.pm 2008-01-29 15:06:17.000000000 -0800
@@ -4,7 +4,7 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.2501';
+$VERSION = '3.27';
@ISA = qw(File::Spec::Unix);
@@ -39,6 +39,8 @@
sub canonpath {
my($self,$path) = @_;
+ return unless defined $path;
+
$path =~ s|\\|/|g;
# Handle network path names beginning with double slash
@@ -51,6 +53,7 @@
sub catdir {
my $self = shift;
+ return unless @_;
# Don't create something that looks like a //network/path
if ($_[0] and ($_[0] eq '/' or $_[0] eq '\\')) {
@@ -109,9 +112,9 @@
=cut
sub case_tolerant () {
- if ($^O ne 'cygwin') {
- return 1;
- }
+ return 1 unless $^O eq 'cygwin'
+ and defined &Cygwin::mount_flags;
+
my $drive = shift;
if (! $drive) {
my @flags = split(/,/, Cygwin::mount_flags('/cygwin'));
==== //depot/maint-5.10/perl/lib/File/Spec/Epoc.pm#2 (text) ====
Index: perl/lib/File/Spec/Epoc.pm
--- perl/lib/File/Spec/Epoc.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/File/Spec/Epoc.pm 2008-01-29 15:06:17.000000000 -0800
@@ -3,7 +3,7 @@
use strict;
use vars qw($VERSION @ISA);
-$VERSION = '3.2501';
+$VERSION = '3.27';
require File::Spec::Unix;
@ISA = qw(File::Spec::Unix);
@@ -45,6 +45,7 @@
sub canonpath {
my ($self,$path) = @_;
+ return unless defined $path;
$path =~ s|/+|/|g; # xx////xx -> xx/xx
$path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx
==== //depot/maint-5.10/perl/lib/File/Spec/Functions.pm#2 (text) ====
Index: perl/lib/File/Spec/Functions.pm
--- perl/lib/File/Spec/Functions.pm#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/lib/File/Spec/Functions.pm 2008-01-29 15:06:17.000000000 -0800
@@ -5,7 +5,7 @@
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
-$VERSION = '3.2501';
+$VERSION = '3.27';
require Exporter;
==== //depot/maint-5.10/perl/lib/File/Spec/Mac.pm#2 (text) ====
Index: perl/lib/File/Spec/Mac.pm
--- perl/lib/File/Spec/Mac.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/File/Spec/Mac.pm 2008-01-29 15:06:17.000000000 -0800
@@ -4,7 +4,7 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.2501';
+$VERSION = '3.27';
@ISA = qw(File::Spec::Unix);
@@ -530,7 +530,7 @@
my @result = ();
my ($head, $sep, $tail, $volume, $directories);
- return ('') if ( (!defined($path)) || ($path eq '') );
+ return @result if ( (!defined($path)) || ($path eq '') );
return (':') if ($path eq ':');
( $volume, $sep, $directories ) = $path =~ m|^((?:[^:]+:)?)(:*)(.*)|s;
==== //depot/maint-5.10/perl/lib/File/Spec/OS2.pm#2 (text) ====
Index: perl/lib/File/Spec/OS2.pm
--- perl/lib/File/Spec/OS2.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/File/Spec/OS2.pm 2008-01-29 15:06:17.000000000 -0800
@@ -4,7 +4,7 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.2501';
+$VERSION = '3.27';
@ISA = qw(File::Spec::Unix);
@@ -54,6 +54,8 @@
sub canonpath {
my ($self,$path) = @_;
+ return unless defined $path;
+
$path =~ s/^([a-z]:)/\l$1/s;
$path =~ s|\\|/|g;
$path =~ s|([^/])/+|$1/|g; # xx////xx -> xx/xx
==== //depot/maint-5.10/perl/lib/File/Spec/Unix.pm#2 (text) ====
Index: perl/lib/File/Spec/Unix.pm
--- perl/lib/File/Spec/Unix.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/File/Spec/Unix.pm 2008-01-29 15:06:17.000000000 -0800
@@ -3,7 +3,7 @@
use strict;
use vars qw($VERSION);
-$VERSION = '3.2501';
+$VERSION = '3.27';
=head1 NAME
@@ -41,6 +41,7 @@
sub canonpath {
my ($self,$path) = @_;
+ return unless defined $path;
# Handle POSIX-style node names beginning with double slash (qnx, nto)
# (POSIX says: "a pathname that begins with two successive slashes
==== //depot/maint-5.10/perl/lib/File/Spec/VMS.pm#2 (text) ====
Index: perl/lib/File/Spec/VMS.pm
--- perl/lib/File/Spec/VMS.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/File/Spec/VMS.pm 2008-01-29 15:06:17.000000000 -0800
@@ -4,7 +4,7 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.2501';
+$VERSION = '3.27';
@ISA = qw(File::Spec::Unix);
==== //depot/maint-5.10/perl/lib/File/Spec/Win32.pm#2 (text) ====
Index: perl/lib/File/Spec/Win32.pm
--- perl/lib/File/Spec/Win32.pm#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/lib/File/Spec/Win32.pm 2008-01-29 15:06:17.000000000 -0800
@@ -5,7 +5,7 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.2501';
+$VERSION = '3.27';
@ISA = qw(File::Spec::Unix);
@@ -126,23 +126,27 @@
=cut
sub catfile {
- my $self = shift;
- my $file = $self->canonpath(pop @_);
- return $file unless @_;
- my $dir = $self->catdir(@_);
- $dir .= "\\" unless substr($dir,-1) eq "\\";
- return $dir.$file;
+ shift;
+
+ # Legacy / compatibility support
+ #
+ shift, return _canon_cat( "/", @_ )
+ if $_[0] eq "";
+
+ return _canon_cat( @_ );
}
sub catdir {
- my $self = shift;
- my @args = @_;
- foreach (@args) {
- tr[/][\\];
- # append a backslash to each argument unless it has one there
- $_ .= "\\" unless m{\\$};
- }
- return $self->canonpath(join('', @args));
+ shift;
+
+ # Legacy / compatibility support
+ #
+ return ""
+ unless @_;
+ shift, return _canon_cat( "/", @_ )
+ if $_[0] eq "";
+
+ return _canon_cat( @_ );
}
sub path {
@@ -165,25 +169,10 @@
=cut
sub canonpath {
- my ($self,$path) = @_;
-
- $path =~ s/^([a-z]:)/\u$1/s;
- $path =~ s|/|\\|g;
- $path =~ s|([^\\])\\+|$1\\|g; # xx\\\\xx -> xx\xx
- $path =~ s|(\\\.)+\\|\\|g; # xx\.\.\xx -> xx\xx
- $path =~ s|^(\.\\)+||s unless $path eq ".\\"; # .\xx -> xx
- $path =~ s|\\\Z(?!\n)||
- unless $path =~ m{^([A-Z]:)?\\\Z(?!\n)}s; # xx\ -> xx
- # xx1/xx2/xx3/../../xx -> xx1/xx
- $path =~ s|\\\.\.\.\\|\\\.\.\\\.\.\\|g; # \...\ is 2 levels up
- $path =~ s|^\.\.\.\\|\.\.\\\.\.\\|g; # ...\ is 2 levels up
- return $path if $path =~ m|^\.\.|; # skip relative paths
- return $path unless $path =~ /\.\./; # too few .'s to cleanup
- return $path if $path =~ /\.\.\.\./; # too many .'s to cleanup
- $path =~ s{^\\\.\.$}{\\}; # \.. -> \
- 1 while $path =~ s{^\\\.\.}{}; # \..\xx -> \xx
-
- return $self->_collapse($path);
+ # Legacy / compatibility support
+ #
+ return $_[1] if !defined($_[1]) or $_[1] eq '';
+ return _canon_cat( $_[1] );
}
=item splitpath
@@ -375,4 +364,69 @@
=cut
+
+sub _canon_cat(@) # @path -> path
+{
+ my $first = shift;
+ my $volume = $first =~ s{ \A ([A-Za-z]:) ([\\/]?) }{}x # drive letter
+ ? ucfirst( $1 ).( $2 ? "\\" : "" )
+ : $first =~ s{ \A (?:\\\\|//) ([^\\/]+)
+ (?: [\\/] ([^\\/]+) )?
+ [\\/]? }{}xs # UNC volume
+ ? "\\\\$1".( defined $2 ? "\\$2" : "" )."\\"
+ : $first =~ s{ \A [\\/] }{}x # root dir
+ ? "\\"
+ : "";
+ my $path = join "\\", $first, @_;
+
+ $path =~ tr#\\/#\\\\#s; # xx/yy --> xx\yy & xx\\yy --> xx\yy
+
+ # xx/././yy --> xx/yy
+ $path =~ s{(?:
+ (?:\A|\\) # at begin or after a slash
+ \.
+ (?:\\\.)* # and more
+ (?:\\|\z) # at end or followed by slash
+ )+ # performance boost -- I do not know why
+ }{\\}gx;
+
+ # XXX I do not know whether more dots are supported by the OS supporting
+ # this ... annotation (NetWare or symbian but not MSWin32).
+ # Then .... could easily become ../../.. etc:
+ # Replace \.\.\. by (\.\.\.+) and substitute with
+ # { $1 . ".." . "\\.." x (length($2)-2) }gex
+ # ... --> ../..
+ $path =~ s{ (\A|\\) # at begin or after a slash
+ \.\.\.
+ (?=\\|\z) # at end or followed by slash
+ }{$1..\\..}gx;
+ # xx\yy\..\zz --> xx\zz
+ while ( $path =~ s{(?:
+ (?:\A|\\) # at begin or after a slash
+ [^\\]+ # rip this 'yy' off
+ \\\.\.
+ (?<!\A\.\.\\\.\.) # do *not* replace ^..\..
+ (?<!\\\.\.\\\.\.) # do *not* replace \..\..
+ (?:\\|\z) # at end or followed by slash
+ )+ # performance boost -- I do not know why
+ }{\\}sx ) {}
+
+ $path =~ s#\A\\##; # \xx --> xx NOTE: this is *not* root
+ $path =~ s#\\\z##; # xx\ --> xx
+
+ if ( $volume =~ m#\\\z# )
+ { # <vol>\.. --> <vol>\
+ $path =~ s{ \A # at begin
+ \.\.
+ (?:\\\.\.)* # and more
+ (?:\\|\z) # at end or followed by slash
+ }{}x;
+
+ return $1 # \\HOST\SHARE\ --> \\HOST\SHARE
+ if $path eq ""
+ and $volume =~ m#\A(\\\\.*)\\\z#s;
+ }
+ return $path ne "" || $volume ? $volume.$path : ".";
+}
+
1;
==== //depot/maint-5.10/perl/lib/File/Spec/t/Spec.t#2 (text) ====
Index: perl/lib/File/Spec/t/Spec.t
--- perl/lib/File/Spec/t/Spec.t#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/lib/File/Spec/t/Spec.t 2008-01-29 15:06:17.000000000 -0800
@@ -191,10 +191,10 @@
[ "Win32->catdir('\\d1','d2')", '\\d1\\d2' ],
[ "Win32->catdir('\\d1','\\d2')", '\\d1\\d2' ],
[ "Win32->catdir('\\d1','\\d2\\')", '\\d1\\d2' ],
-[ "Win32->catdir('','/d1','d2')", '\\\\d1\\d2' ],
-[ "Win32->catdir('','','/d1','d2')", '\\\\\\d1\\d2' ],
-[ "Win32->catdir('','//d1','d2')", '\\\\\\d1\\d2' ],
-[ "Win32->catdir('','','//d1','d2')", '\\\\\\\\d1\\d2' ],
+[ "Win32->catdir('','/d1','d2')", '\\d1\\d2' ],
+[ "Win32->catdir('','','/d1','d2')", '\\d1\\d2' ],
+[ "Win32->catdir('','//d1','d2')", '\\d1\\d2' ],
+[ "Win32->catdir('','','//d1','d2')", '\\d1\\d2' ],
[ "Win32->catdir('','d1','','d2','')", '\\d1\\d2' ],
[ "Win32->catdir('','d1','d2','d3','')", '\\d1\\d2\\d3' ],
[ "Win32->catdir('d1','d2','d3','')", 'd1\\d2\\d3' ],
@@ -206,13 +206,14 @@
[ "Win32->catdir('A:/d1','B:/d2','d3','')", 'A:\\d1\\B:\\d2\\d3' ],
[ "Win32->catdir('A:/')", 'A:\\' ],
[ "Win32->catdir('\\', 'foo')", '\\foo' ],
-
+[ "Win32->catdir('','','..')", '\\' ],
[ "Win32->catfile('a','b','c')", 'a\\b\\c' ],
[ "Win32->catfile('a','b','.\\c')", 'a\\b\\c' ],
[ "Win32->catfile('.\\a','b','c')", 'a\\b\\c' ],
[ "Win32->catfile('c')", 'c' ],
[ "Win32->catfile('.\\c')", 'c' ],
+[ "Win32->catfile('a/..','../b')", '..\\b' ],
[ "Win32->canonpath('')", '' ],
@@ -224,9 +225,9 @@
[ "Win32->canonpath('//a\\b//c')", '\\\\a\\b\\c' ],
[ "Win32->canonpath('/a/..../c')", '\\a\\....\\c' ],
[ "Win32->canonpath('//a/b\\c')", '\\\\a\\b\\c' ],
-[ "Win32->canonpath('////')", '\\\\\\' ],
+[ "Win32->canonpath('////')", '\\' ],
[ "Win32->canonpath('//')", '\\' ],
-[ "Win32->canonpath('/.')", '\\.' ],
+[ "Win32->canonpath('/.')", '\\' ],
[ "Win32->canonpath('//a/b/../../c')", '\\\\a\\b\\c' ],
[ "Win32->canonpath('//a/b/c/../d')", '\\\\a\\b\\d' ],
[ "Win32->canonpath('//a/b/c/../../d')",'\\\\a\\b\\d' ],
@@ -694,6 +695,7 @@
[ "Cygwin->rel2abs('..','/t1/t2/t3')", '/t1/t2/t3/..' ],
[ "Cygwin->rel2abs('../t4','/t1/t2/t3')", '/t1/t2/t3/../t4' ],
[ "Cygwin->rel2abs('/t1','/t1/t2/t3')", '/t1' ],
+[ "Cygwin->rel2abs('//t1/t2/t3','/foo')", '//t1/t2/t3' ],
) ;
==== //depot/maint-5.10/perl/lib/File/Spec/t/crossplatform.t#2 (text) ====
Index: perl/lib/File/Spec/t/crossplatform.t
--- perl/lib/File/Spec/t/crossplatform.t#1~32694~ 2007-12-22
01:23:09.000000000 -0800
+++ perl/lib/File/Spec/t/crossplatform.t 2008-01-29 15:06:17.000000000
-0800
@@ -7,7 +7,7 @@
local $|=1;
my @platforms = qw(Cygwin Epoc Mac OS2 Unix VMS Win32);
-my $tests_per_platform = 7;
+my $tests_per_platform = 10;
plan tests => 1 + @platforms * $tests_per_platform;
@@ -56,6 +56,17 @@
is $module->file_name_is_absolute($base), 1, "$base is absolute on
$platform";
+ # splitdir('') -> ()
+ my @result = $module->splitdir('');
+ is @result, 0, "$platform->splitdir('') -> ()";
+
+ # canonpath() -> undef
+ $result = $module->canonpath();
+ is $result, undef, "$platform->canonpath() -> undef";
+
+ # canonpath(undef) -> undef
+ $result = $module->canonpath(undef);
+ is $result, undef, "$platform->canonpath(undef) -> undef";
# abs2rel('A:/foo/bar', 'A:/foo') -> 'bar'
$file = $module->catpath($v, $module->catdir($module->rootdir, 'foo',
'bar'), 'file');
==== //depot/maint-5.10/perl/lib/File/Spec/t/tmpdir.t#2 (text) ====
Index: perl/lib/File/Spec/t/tmpdir.t
--- perl/lib/File/Spec/t/tmpdir.t#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/lib/File/Spec/t/tmpdir.t 2008-01-29 15:06:17.000000000 -0800
@@ -14,9 +14,8 @@
ok scalar keys %ENV, $num_keys, "tmpdir() shouldn't change the contents of
%ENV";
if ($^O eq 'VMS') {
- skip('Can\'t make list assignment to \%ENV on this system', 1);
-}
-else {
+ skip("Can't make list assignment to %ENV on this system", 1);
+} else {
local %ENV;
File::Spec::Win32->tmpdir;
ok scalar keys %ENV, 0, "Win32->tmpdir() shouldn't change the contents of
%ENV";
End of Patch.
