This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
File-Glob: exercise GLOB_MARK, GLOB_NOCHECK, etc.
authorJames E Keenan <jkeenan@cpan.org>
Tue, 26 Dec 2023 13:35:58 +0000 (13:35 +0000)
committerJames E Keenan <jkeenan@cpan.org>
Mon, 1 Jan 2024 22:28:36 +0000 (17:28 -0500)
For GH #21744

t/basic.t:

* Exercise GLOB_NOCHECK flag, without and with GLOB_QUOTE flag.

* Move one particular assignment to '@a' was only used within
the subsequent SKIP block.  For consistency with other SKIP blocks, move
list assignment to within the block.

* Exercise GLOB_NOSORT flag, thereby confirming that it is the default
sorting mechanism.  There is, of course, a slight chance that using
GLOB_NOSORT will return names in the same order as the default
GLOB_ALPHASORT.  So the best we can do is to confirm that the same names
were returned in each instance.

* Explicitly test GLOB_ALPHASORT

t/global.t:

* Provide descriptions for two unit tests previously lacking
them.

Corrections:
* t/basic.t: Tidy leading whitespace
* Glob.pm: One-character typo
* Increment $VERSION.
* Correct count within SKIP block

ext/File-Glob/Glob.pm
ext/File-Glob/t/basic.t
ext/File-Glob/t/global.t

index f7b89f4..35cd2a8 100644 (file)
@@ -33,7 +33,7 @@ $EXPORT_TAGS{bsd_glob} = [@{$EXPORT_TAGS{glob}}];
 
 our @EXPORT_OK   = (@{$EXPORT_TAGS{'glob'}}, 'csh_glob');
 
-our $VERSION = '1.40';
+our $VERSION = '1.41';
 
 sub import {
     require Exporter;
@@ -190,7 +190,7 @@ uses this internally.
 
 =head2 POSIX FLAGS
 
-If no flags argument is give then C<GLOB_CSH> is set, and on VMS and
+If no flags argument is given then C<GLOB_CSH> is set, and on VMS and
 Windows systems, C<GLOB_NOCASE> too.  Otherwise the flags to use are
 determined solely by the flags argument.  The POSIX defined flags are:
 
index 412fe7e..b6bca0b 100644 (file)
@@ -10,7 +10,7 @@ BEGIN {
     }
 }
 use strict;
-use Test::More tests => 49;
+use Test::More tests => 56;
 BEGIN {use_ok('File::Glob', ':glob')};
 use Cwd ();
 
@@ -59,14 +59,14 @@ my @a;
 
 SKIP: {
     my ($name, $home);
-    skip $^O, 1 if $^O eq 'MSWin32' || $^O eq 'VMS'
-       || $^O eq 'os2';
-    skip "Can't find user for $>: $@", 1 unless eval {
-       ($name, $home) = (getpwuid($>))[0,7];
-       1;
+    skip $^O, 2 if $^O eq 'MSWin32' || $^O eq 'VMS'
+        || $^O eq 'os2';
+    skip "Can't find user for $>: $@", 2 unless eval {
+        ($name, $home) = (getpwuid($>))[0,7];
+        1;
     };
-    skip "$> has no home directory", 1
-       unless defined $home && defined $name && -d $home;
+    skip "$> has no home directory", 2
+        unless defined $home && defined $name && -d $home;
 
     @a = bsd_glob("~$name", GLOB_TILDE);
 
@@ -77,6 +77,16 @@ SKIP: {
             "GLOB_TILDE expands patterns that start with '~' to user name home directories"
         );
     }
+
+    my @b = bsd_glob("~$name", GLOB_TILDE | GLOB_MARK);
+
+    if (GLOB_ERROR) {
+        fail(GLOB_ERROR);
+    } else {
+        is_deeply (\@b, ["$home/"],
+            "GLOB_MARK matches directories with path separator attached"
+        );
+    }
 }
 # check plain tilde expansion
 {
@@ -131,10 +141,23 @@ if (GLOB_ERROR) {
 # check nonexistent checks
 # should return an empty list
 # XXX since errfunc is NULL on win32, this test is not valid there
-@a = bsd_glob("asdfasdf", 0);
 SKIP: {
-    skip $^O, 1 if $^O eq 'MSWin32';
+    skip $^O, 5 if $^O eq 'MSWin32';
+    my @a = bsd_glob("asdfasdf", 0);
     is_deeply(\@a, [], "bsd_glob() works as expected for unmatched pattern and 0 flag");
+
+    my $pattern = "asdfasdf";
+    @a = bsd_glob($pattern, GLOB_NOCHECK);
+    is(scalar @a, 1,
+        "unmatched pattern with GLOB_NOCHECK returned single-item list");
+    cmp_ok($a[0], 'eq', $pattern,
+        "bsd_glob() works as expected for unmatched pattern and GLOB_NOCHECK flag");
+
+    my @b = bsd_glob($pattern, GLOB_NOCHECK | GLOB_QUOTE);
+    is(scalar @b, 1,
+        "unmatched pattern with GLOB_NOCHECK and GLOB_QUOTE returned single-item list");
+    cmp_ok($b[0], 'eq', $pattern,
+        "bsd_glob() works as expected for unmatched pattern and GLOB_NOCHECK and GLOB_QUOTE flags");
 }
 
 # check bad protections
@@ -212,6 +235,18 @@ print "# f_alpha = @f_alpha\n";
 print "# g_alpha = @g_alpha\n";
 is_deeply(\@g_alpha, \@f_alpha, "Got expected case-insensitive list of filenames");
 
+my @h_alpha = bsd_glob($pat, GLOB_ALPHASORT);
+print "# f_alpha = @f_alpha\n";
+print "# h_alpha = @h_alpha\n";
+is_deeply(\@h_alpha, \@f_alpha,
+    "Got expected case-insensitive list of filenames (explicit GLOB_ALPHASORT)");
+
+my (%h_seen, %i_seen);
+map { $h_seen{$_} => 1 } @h_alpha;
+map { $i_seen{$_} => 1 } bsd_glob($pat, GLOB_NOSORT);
+is_deeply(\%h_seen, \%i_seen,
+    "GLOB_NOSORT saw same names as default (though probably not in same order)");
+
 unlink @f_names;
 chdir "..";
 rmdir "pteerslo";
@@ -272,7 +307,7 @@ use File::Glob ':bsd_glob';
 use Test::More;
 for (qw[
         GLOB_ABEND
-       GLOB_ALPHASORT
+        GLOB_ALPHASORT
         GLOB_ALTDIRFUNC
         GLOB_BRACE
         GLOB_CSH
index cc1f8d0..cf7d5b2 100644 (file)
@@ -31,9 +31,9 @@ BEGIN {
 
 $_ = "op/*.t";
 my @r = glob;
-is($_, "op/*.t");
+is($_, "op/*.t", 'pattern intact after use of core glob function');
 
-cmp_ok(scalar @r, '>=', 3);
+cmp_ok(scalar @r, '>=', 3, 'check if core glob function works');
 
 @r = <*/*.t>;
 # at least t/global.t t/basic.t, t/taint.t