Thanks for the patch. I actually had to modify it a bit to also get Win32 foreign paths to work
correctly on Unix:
Index: Changes
=========================================================
==========
RCS file: /Users/ken/src/CVS-repository/modules/Path-Class/Changes,v
retrieving revision 1.53
diff -u -r1.53 Changes
--- Changes 27 Nov 2006 01:22:41 -0000 1.53
+++ Changes 25 Dec 2006 02:16:50 -0000
@@ -8,6 +8,9 @@
- Fixed a typo in the synopsis for Path::Class::Dir - 'MacOS' should
have been 'Mac' in the example for foreign_dir(). [Chris Dolan]
+ - subsumes() was not respecting the 'foreign'-ness of its arguments,
+ now it does. [Chia-liang Kao]
+
0.15 Thu Dec 15 20:11:38 CST 2005
- Fixed an important edge case in subsumes() - subsumes('/', '/foo')
Index: lib/Path/Class/Dir.pm
=========================================================
==========
RCS file: /Users/ken/src/CVS-repository/modules/Path-Class/lib/Path/Class/Dir.pm,v
retrieving revision 1.31
diff -u -r1.31 Dir.pm
--- lib/Path/Class/Dir.pm 27 Nov 2006 01:22:41 -0000 1.31
+++ lib/Path/Class/Dir.pm 25 Dec 2006 02:13:17 -0000
@@ -195,7 +195,7 @@
my ($self, $other) = @_;
die "No second entity given to subsumes()" unless $other;
- $other = ref($self)->new($other) unless UNIVERSAL::isa($other, __PACKAGE__);
+ $other = $self->new($other) unless UNIVERSAL::isa($other, __PACKAGE__);
$other = $other->dir unless $other->is_dir;
if ($self->is_absolute) {
@@ -211,8 +211,9 @@
return 0 unless $other->volume eq $self->volume;
}
- # The root dir subsumes everything
- return 1 if $self eq ref($self)->new('');
+ # The root dir subsumes everything (but ignore the volume because
+ # we've already checked that)
+ return 1 if "@{$self->{dirs}}" eq "@{$self->new('')->{dirs}}";
my $i = 0;
while ($i <= $#{ $self->{dirs} }) {
Index: t/02-foreign.t
=========================================================
==========
RCS file: /Users/ken/src/CVS-repository/modules/Path-Class/t/02-foreign.t,v
retrieving revision 1.5
diff -u -r1.5 02-foreign.t
--- t/02-foreign.t 30 May 2005 04:11:59 -0000 1.5
+++ t/02-foreign.t 25 Dec 2006 02:15:08 -0000
@@ -1,6 +1,6 @@
use Test;
use strict;
-BEGIN { plan tests => 23 };
+BEGIN { plan tests => 29 };
use Path::Class qw(file dir foreign_file foreign_dir);
ok(1);
@@ -36,6 +36,15 @@
skip "skip Can't test VMS code on other platforms", 1;
}
+{
+ # subsumes() should respect foreignness
+ my ($me, $other) = map { Path::Class::Dir->new_foreign('Unix', $_) } qw(/ /Foo);
+ ok($me->subsumes($other));
+
+ ($me, $other) = map { Path::Class::Dir->new_foreign('Win32', $_) } qw(C:\ C:\Foo);
+ ok($me->subsumes($other));
+}
+
# Note that "\\" and '\\' are each a single backslash
$dir = foreign_dir('Win32', 'C:\\');
ok $dir, 'C:\\';
RT for rt.cpan.org