This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make csh_glob remove quote-escaping backslashes
[perl5.git] / ext / File-Glob / t / basic.t
index b9d46b1..df2b958 100644 (file)
@@ -2,12 +2,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    if ($^O eq 'MacOS') { 
-       @INC = qw(: ::lib ::macos:lib); 
-    } else { 
-       @INC = '.'; 
-       push @INC, '../lib'; 
-    }
+    @INC = '../lib';
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
         print "1..0\n";
@@ -15,7 +10,7 @@ BEGIN {
     }
 }
 use strict;
-use Test::More tests => 14;
+use Test::More tests => 29;
 BEGIN {use_ok('File::Glob', ':glob')};
 use Cwd ();
 
@@ -40,7 +35,7 @@ if ($^O eq 'VMS') {
 $ENV{PATH} = "/bin";
 delete @ENV{qw(BASH_ENV CDPATH ENV IFS)};
 my @correct = ();
-if (opendir(D, $^O eq "MacOS" ? ":" : ".")) {
+if (opendir(D, ".")) {
    @correct = grep { !/^\./ } sort readdir(D);
    closedir D;
 }
@@ -73,6 +68,46 @@ SKIP: {
        is_deeply (\@a, [$home]);
     }
 }
+# check plain tilde expansion
+{
+    my $tilde_check = sub {
+        my @a = bsd_glob('~');
+
+        if (GLOB_ERROR) {
+            fail(GLOB_ERROR);
+        } else {
+            is_deeply (\@a, [$_[0]], join ' - ', 'tilde expansion', @_ > 1 ? $_[1] : ());
+        }
+    };
+    my $passwd_home = eval { (getpwuid($>))[7] };
+
+    TODO: {
+        local $TODO = 'directory brackets look like pattern brackets to glob' if $^O eq 'VMS';
+        local $ENV{HOME};
+        delete $ENV{HOME};
+        local $ENV{USERPROFILE};
+        delete $ENV{USERPROFILE};
+        $tilde_check->(defined $passwd_home ? $passwd_home : q{~}, 'no environment');
+    }
+
+    SKIP: {
+        skip 'MSWin32 only', 1 if $^O ne 'MSWin32';
+        local $ENV{HOME};
+        delete $ENV{HOME};
+        local $ENV{USERPROFILE};
+        $ENV{USERPROFILE} = 'sweet win32 home';
+        $tilde_check->(defined $passwd_home ? $passwd_home : $ENV{USERPROFILE}, 'USERPROFILE');
+    }
+
+    TODO: {
+        local $TODO = 'directory brackets look like pattern brackets to glob' if $^O eq 'VMS';
+        my $home = exists $ENV{HOME} ? $ENV{HOME}
+        : eval { getpwuid($>); 1 } ? (getpwuid($>))[7]
+        : $^O eq 'MSWin32' && exists $ENV{USERPROFILE} ? $ENV{USERPROFILE}
+        : q{~};
+        $tilde_check->($home);
+    }
+}
 
 # check backslashing
 # should return a list with one item, and not set ERROR
@@ -129,10 +164,9 @@ print "# @a\n";
 is_deeply(\@a, [($vms_mode ? 'test.' : 'TEST'), 'a', 'b']);
 
 # "~" should expand to $ENV{HOME}
-$ENV{HOME} = "sweet home";
-@a = bsd_glob('~', GLOB_TILDE | GLOB_NOMAGIC);
-SKIP: {
-    skip $^O, 1 if $^O eq "MacOS";
+{
+    local $ENV{HOME} = "sweet home";
+    @a = bsd_glob('~', GLOB_TILDE | GLOB_NOMAGIC);
     is_deeply(\@a, [$ENV{HOME}]);
 }
 
@@ -195,3 +229,26 @@ pass("Don't panic");
     local $TODO = "home-made glob doesn't do regexes" if $^O eq 'VMS';
     is_deeply(\@glob_files, ['a_dej']);
 }
+
+# This used to segfault.
+my $i = bsd_glob('*', GLOB_ALTDIRFUNC);
+is(&File::Glob::GLOB_ERROR, 0, "Successfuly ignored unsupported flag");
+
+package frimpy; # get away from the glob override, so we can test csh_glob,
+use Test::More;  # which is perl's default
+
+# In case of PERL_EXTERNAL_GLOB:
+use subs 'glob';
+BEGIN { *glob = \&File::Glob::csh_glob }
+
+is +(glob "a'b'")[0], (<a'b' c>)[0], "a'b' with and without spaces";
+is <a"b">, 'ab', 'a"b" without spaces';
+is_deeply [<a"b" c>], [qw<ab c>], 'a"b" without spaces';
+is_deeply [<\\* .\\*>], [<\\*>,<.\\*>], 'backslashes with(out) spaces';
+like <\\ >, qr/^\\? \z/, 'final escaped space';
+is <a"b>, 'a"b', 'unmatched quote';
+is < a"b >, 'a"b', 'unmatched quote with surrounding spaces';
+is glob('a\"b'), 'a"b', '\ before quote *only* escapes quote';
+is glob(q"a\'b"), "a'b", '\ before single quote *only* escapes quote';
+is glob('"a\"b c\"d"'), 'a"b c"d', 'before \" within "..."';
+is glob(q"'a\'b c\'d'"), "a'b c'd", q"before \' within '...'";