Fix merge issues, remove excess files - match perl-5.24.1 dist

4 files changed, 555 insertions, 241 deletions

diff --git a/gnu/usr.bin/perl/ext/File-Glob/Glob.pm b/gnu/usr.bin/perl/ext/File-Glob/Glob.pm
index 15d4adb6bbe..c0b5a4720d9 100644
--- a/gnu/usr.bin/perl/ext/File-Glob/Glob.pm
+++ b/gnu/usr.bin/perl/ext/File-Glob/Glob.pm
@@ -1,38 +1,15 @@
 package File::Glob;
 
 use strict;
-our($VERSION, @ISA, @EXPORT_OK, @EXPORT_FAIL, %EXPORT_TAGS,
-    $AUTOLOAD, $DEFAULT_FLAGS);
+our($VERSION, @ISA, @EXPORT_OK, @EXPORT_FAIL, %EXPORT_TAGS, $DEFAULT_FLAGS);
 
-use XSLoader ();
+require XSLoader;
 
 @ISA = qw(Exporter);
 
 # NOTE: The glob() export is only here for compatibility with 5.6.0.
 # csh_glob() should not be used directly, unless you know what you're doing.
 
-@EXPORT_OK   = qw(
-    csh_glob
-    bsd_glob
-    glob
-    GLOB_ABEND
-    GLOB_ALPHASORT
-    GLOB_ALTDIRFUNC
-    GLOB_BRACE
-    GLOB_CSH
-    GLOB_ERR
-    GLOB_ERROR
-    GLOB_LIMIT
-    GLOB_MARK
-    GLOB_NOCASE
-    GLOB_NOCHECK
-    GLOB_NOMAGIC
-    GLOB_NOSORT
-    GLOB_NOSPACE
-    GLOB_QUOTE
-    GLOB_TILDE
-);
-
 %EXPORT_TAGS = (
     'glob' => [ qw(
         GLOB_ABEND
@@ -51,140 +28,57 @@ use XSLoader ();
         GLOB_NOSPACE
         GLOB_QUOTE
         GLOB_TILDE
-        glob
         bsd_glob
+        glob
     ) ],
 );
+$EXPORT_TAGS{bsd_glob} = [@{$EXPORT_TAGS{glob}}];
+pop @{$EXPORT_TAGS{bsd_glob}}; # no "glob"
+
+@EXPORT_OK   = (@{$EXPORT_TAGS{'glob'}}, 'csh_glob');
 
-$VERSION = '1.06';
+$VERSION = '1.26';
 
 sub import {
     require Exporter;
-    my $i = 1;
-    while ($i < @_) {
-	if ($_[$i] =~ /^:(case|nocase|globally)$/) {
-	    splice(@_, $i, 1);
-	    $DEFAULT_FLAGS &= ~GLOB_NOCASE() if $1 eq 'case';
-	    $DEFAULT_FLAGS |= GLOB_NOCASE() if $1 eq 'nocase';
-	    if ($1 eq 'globally') {
-		local $^W;
-		*CORE::GLOBAL::glob = \&File::Glob::csh_glob;
-	    }
-	    next;
+    local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
+    Exporter::import(grep {
+        my $passthrough;
+        if ($_ eq ':case') {
+            $DEFAULT_FLAGS &= ~GLOB_NOCASE()
+        }
+        elsif ($_ eq ':nocase') {
+            $DEFAULT_FLAGS |= GLOB_NOCASE();
+        }
+        elsif ($_ eq ':globally') {
+	    no warnings 'redefine';
+	    *CORE::GLOBAL::glob = \&File::Glob::csh_glob;
 	}
-	++$i;
-    }
-    goto &Exporter::import;
-}
-
-sub AUTOLOAD {
-    # This AUTOLOAD is used to 'autoload' constants from the constant()
-    # XS function.  If a constant is not found then control is passed
-    # to the AUTOLOAD in AutoLoader.
-
-    my $constname;
-    ($constname = $AUTOLOAD) =~ s/.*:://;
-    my ($error, $val) = constant($constname);
-    if ($error) {
-	require Carp;
-	Carp::croak($error);
-    }
-    eval "sub $AUTOLOAD { $val }";
-    goto &$AUTOLOAD;
-}
-
-XSLoader::load 'File::Glob', $VERSION;
-
-# Preloaded methods go here.
-
-sub GLOB_ERROR {
-    return (constant('GLOB_ERROR'))[1];
+        elsif ($_ eq ':bsd_glob') {
+	    no strict; *{caller."::glob"} = \&bsd_glob_override;
+            $passthrough = 1;
+	}
+	else {
+            $passthrough = 1;
+        }
+        $passthrough;
+    } @_);
 }
 
-sub GLOB_CSH () {
-    GLOB_BRACE()
-	| GLOB_NOMAGIC()
-	| GLOB_QUOTE()
-	| GLOB_TILDE()
-	| GLOB_ALPHASORT()
-}
+XSLoader::load();
 
 $DEFAULT_FLAGS = GLOB_CSH();
-if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos|MacOS)$/) {
+if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos)$/) {
     $DEFAULT_FLAGS |= GLOB_NOCASE();
 }
 
-# Autoload methods go after =cut, and are processed by the autosplit program.
-
-sub bsd_glob {
-    my ($pat,$flags) = @_;
-    $flags = $DEFAULT_FLAGS if @_ < 2;
-    return doglob($pat,$flags);
-}
-
 # File::Glob::glob() is deprecated because its prototype is different from
 # CORE::glob() (use bsd_glob() instead)
 sub glob {
-    splice @_, 1; # don't pass PL_glob_index as flags!
+    splice @_, 1; # no flags
     goto &bsd_glob;
 }
 
-## borrowed heavily from gsar's File::DosGlob
-my %iter;
-my %entries;
-
-sub csh_glob {
-    my $pat = shift;
-    my $cxix = shift;
-    my @pat;
-
-    # glob without args defaults to $_
-    $pat = $_ unless defined $pat;
-
-    # extract patterns
-    $pat =~ s/^\s+//;	# Protect against empty elements in
-    $pat =~ s/\s+$//;	# things like < *.c> and <*.c >.
-			# These alone shouldn't trigger ParseWords.
-    if ($pat =~ /\s/) {
-        # XXX this is needed for compatibility with the csh
-	# implementation in Perl.  Need to support a flag
-	# to disable this behavior.
-	require Text::ParseWords;
-	@pat = Text::ParseWords::parse_line('\s+',0,$pat);
-    }
-
-    # assume global context if not provided one
-    $cxix = '_G_' unless defined $cxix;
-    $iter{$cxix} = 0 unless exists $iter{$cxix};
-
-    # if we're just beginning, do it all first
-    if ($iter{$cxix} == 0) {
-	if (@pat) {
-	    $entries{$cxix} = [ map { doglob($_, $DEFAULT_FLAGS) } @pat ];
-	}
-	else {
-	    $entries{$cxix} = [ doglob($pat, $DEFAULT_FLAGS) ];
-	}
-    }
-
-    # chuck it all out, quick or slow
-    if (wantarray) {
-        delete $iter{$cxix};
-        return @{delete $entries{$cxix}};
-    }
-    else {
-        if ($iter{$cxix} = scalar @{$entries{$cxix}}) {
-            return shift @{$entries{$cxix}};
-        }
-        else {
-            # return undef for EOL
-            delete $iter{$cxix};
-            delete $entries{$cxix};
-            return undef;
-        }
-    }
-}
-
 1;
 __END__
 
@@ -194,7 +88,7 @@ File::Glob - Perl extension for BSD glob routine
 
 =head1 SYNOPSIS
 
-  use File::Glob ':glob';
+  use File::Glob ':bsd_glob';
 
   @list = bsd_glob('*.[ch]');
   $homedir = bsd_glob('~gnat', GLOB_TILDE | GLOB_ERR);
@@ -237,7 +131,8 @@ Since v5.6.0, Perl's CORE::glob() is implemented in terms of bsd_glob().
 Note that they don't share the same prototype--CORE::glob() only accepts
 a single argument.  Due to historical reasons, CORE::glob() will also
 split its argument on whitespace, treating it as multiple patterns,
-whereas bsd_glob() considers them as one pattern.
+whereas bsd_glob() considers them as one pattern.  But see C<:bsd_glob>
+under L</EXPORTS>, below.
 
 =head2 META CHARACTERS
 
@@ -250,9 +145,55 @@ whereas bsd_glob() considers them as one pattern.
 
 The metanotation C<a{b,c,d}e> is a shorthand for C<abe ace ade>.  Left to
 right order is preserved, with results of matches being sorted separately
-at a low level to preserve this order. As a special case C<{>, C<}>, and
+at a low level to preserve this order.  As a special case C<{>, C<}>, and
 C<{}> are passed undisturbed.
 
+=head2 EXPORTS
+
+See also the L</POSIX FLAGS> below, which can be exported individually.
+
+=head3 C<:bsd_glob>
+
+The C<:bsd_glob> export tag exports bsd_glob() and the constants listed
+below.  It also overrides glob() in the calling package with one that
+behaves like bsd_glob() with regard to spaces (the space is treated as part
+of a file name), but supports iteration in scalar context; i.e., it
+preserves the core function's feature of returning the next item each time
+it is called.
+
+=head3 C<:glob>
+
+The C<:glob> tag, now discouraged, is the old version of C<:bsd_glob>.  It
+exports the same constants and functions, but its glob() override does not
+support iteration; it returns the last file name in scalar context.  That
+means this will loop forever:
+
+    use File::Glob ':glob';
+    while (my $file = <* copy.txt>) {
+	...
+    }
+
+=head3 C<bsd_glob>
+
+This function, which is included in the two export tags listed above,
+takes one or two arguments.  The first is the glob pattern.  The second is
+a set of flags ORed together.  The available flags are listed below under
+L</POSIX FLAGS>.  If the second argument is omitted, C<GLOB_CSH> (or
+C<GLOB_CSH|GLOB_NOCASE> on VMS and DOSish systems) is used by default.
+
+=head3 C<:nocase> and C<:case>
+
+These two export tags globally modify the default flags that bsd_glob()
+and, except on VMS, Perl's built-in C<glob> operator use.  C<GLOB_NOCASE>
+is turned on or off, respectively.
+
+=head3 C<csh_glob>
+
+The csh_glob() function can also be exported, but you should not use it
+directly unless you really know what you are doing.  It splits the pattern
+into words and feeds each one to bsd_glob().  Perl's own glob() function
+uses this internally.
+
 =head2 POSIX FLAGS
 
 The POSIX defined flags for bsd_glob() are:
@@ -393,10 +334,10 @@ Remember that you can use a backslash to escape things.
 
 On DOSISH systems, backslash is a valid directory separator character.
 In this case, use of backslash as a quoting character (via GLOB_QUOTE)
-interferes with the use of backslash as a directory separator. The
+interferes with the use of backslash as a directory separator.  The
 best (simplest, most portable) solution is to use forward slashes for
-directory separators, and backslashes for quoting. However, this does
-not match "normal practice" on these systems. As a concession to user
+directory separators, and backslashes for quoting.  However, this does
+not match "normal practice" on these systems.  As a concession to user
 expectation, therefore, backslashes (under GLOB_QUOTE) only quote the
 glob metacharacters '[', ']', '{', '}', '-', '~', and backslash itself.
 All other backslashes are passed through unchanged.
@@ -407,46 +348,6 @@ Win32 users should use the real slash.  If you really want to use
 backslashes, consider using Sarathy's File::DosGlob, which comes with
 the standard Perl distribution.
 
-=item *
-
-Mac OS (Classic) users should note a few differences. Since
-Mac OS is not Unix, when the glob code encounters a tilde glob (e.g.
-~user) and the C<GLOB_TILDE> flag is used, it simply returns that
-pattern without doing any expansion.
-
-Glob on Mac OS is case-insensitive by default (if you don't use any
-flags). If you specify any flags at all and still want glob
-to be case-insensitive, you must include C<GLOB_NOCASE> in the flags.
-
-The path separator is ':' (aka colon), not '/' (aka slash). Mac OS users
-should be careful about specifying relative pathnames. While a full path
-always begins with a volume name, a relative pathname should always
-begin with a ':'.  If specifying a volume name only, a trailing ':' is
-required.
-
-The specification of pathnames in glob patterns adheres to the usual Mac
-OS conventions: The path separator is a colon ':', not a slash '/'. A
-full path always begins with a volume name. A relative pathname on Mac
-OS must always begin with a ':', except when specifying a file or
-directory name in the current working directory, where the leading colon
-is optional. If specifying a volume name only, a trailing ':' is
-required. Due to these rules, a glob like E<lt>*:E<gt> will find all
-mounted volumes, while a glob like E<lt>*E<gt> or E<lt>:*E<gt> will find
-all files and directories in the current directory.
-
-Note that updirs in the glob pattern are resolved before the matching begins,
-i.e. a pattern like "*HD:t?p::a*" will be matched as "*HD:a*". Note also,
-that a single trailing ':' in the pattern is ignored (unless it's a volume
-name pattern like "*HD:"), i.e. a glob like E<lt>:*:E<gt> will find both
-directories I<and> files (and not, as one might expect, only directories).
-You can, however, use the C<GLOB_MARK> flag to distinguish (without a file
-test) directory names from file names.
-
-If the C<GLOB_MARK> flag is set, all directory paths will have a ':' appended.
-Since a directory like 'lib:' is I<not> a valid I<relative> path on Mac OS,
-both a leading and a trailing colon will be added, when the directory name in
-question doesn't contain any colons (e.g. 'lib' becomes ':lib:').
-
 =back
 
 =head1 SEE ALSO
@@ -462,35 +363,47 @@ E<lt>gsar@activestate.comE<gt>, and Thomas Wegner
 E<lt>wegner_thomas@yahoo.comE<gt>.  The C glob code has the
 following copyright:
 
-    Copyright (c) 1989, 1993 The Regents of the University of California.
-    All rights reserved.
-
-    This code is derived from software contributed to Berkeley by
-    Guido van Rossum.
-
-    Redistribution and use in source and binary forms, with or without
-    modification, are permitted provided that the following conditions
-    are met:
-
-    1. Redistributions of source code must retain the above copyright
-       notice, this list of conditions and the following disclaimer.
-    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.
-
-    THIS SOFTWARE IS PROVIDED BY THE REGENTS 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
-    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)
-    HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-    OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-    SUCH DAMAGE.
+Copyright (c) 1989, 1993 The Regents of the University of California.
+All rights reserved.
+
+This code is derived from software contributed to Berkeley by
+Guido van Rossum.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+=over 4
+
+=item 1.
+
+Redistributions of source code must retain the above copyright
+notice, this list of conditions and the following disclaimer.
+
+=item 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.
+
+=item 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.
+
+=back
+
+THIS SOFTWARE IS PROVIDED BY THE REGENTS 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
+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)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGE.
 
 =cut
diff --git a/gnu/usr.bin/perl/ext/File-Glob/Glob.xs b/gnu/usr.bin/perl/ext/File-Glob/Glob.xs
index 3a526fbf03b..e0a36814e09 100644
--- a/gnu/usr.bin/perl/ext/File-Glob/Glob.xs
+++ b/gnu/usr.bin/perl/ext/File-Glob/Glob.xs
@@ -1,3 +1,5 @@
+#define PERL_NO_GET_CONTEXT
+
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -7,7 +9,12 @@
 #define MY_CXT_KEY "File::Glob::_guts" XS_VERSION
 
 typedef struct {
+#ifdef USE_ITHREADS
+    tTHX interp;
+#endif
     int		x_GLOB_ERROR;
+    HV *	x_GLOB_ENTRIES;
+    Perl_ophook_t	x_GLOB_OLD_OPHOOK;
 } my_cxt_t;
 
 START_MY_CXT
@@ -21,37 +28,24 @@ START_MY_CXT
 #else
 static int
 errfunc(const char *foo, int bar) {
+  PERL_UNUSED_ARG(foo);
   return !(bar == EACCES || bar == ENOENT || bar == ENOTDIR);
 }
 #endif
 
-MODULE = File::Glob		PACKAGE = File::Glob
-
-BOOT:
+static void
+doglob(pTHX_ const char *pattern, int flags)
 {
-    MY_CXT_INIT;
-}
-
-void
-doglob(pattern,...)
-    char *pattern
-PROTOTYPE: $;$
-PREINIT:
+    dSP;
     glob_t pglob;
     int i;
     int retval;
-    int flags = 0;
     SV *tmp;
-PPCODE:
     {
 	dMY_CXT;
 
-	/* allow for optional flags argument */
-	if (items > 1) {
-	    flags = (int) SvIV(ST(1));
-	}
-
 	/* call glob */
+	memset(&pglob, 0, sizeof(glob_t));
 	retval = bsd_glob(pattern, flags, errfunc, &pglob);
 	GLOB_ERROR = retval;
 
@@ -59,14 +53,410 @@ PPCODE:
 	EXTEND(sp, pglob.gl_pathc);
 	for (i = 0; i < pglob.gl_pathc; i++) {
 	    /* printf("# bsd_glob: %s\n", pglob.gl_pathv[i]); */
-	    tmp = sv_2mortal(newSVpvn(pglob.gl_pathv[i],
-				      strlen(pglob.gl_pathv[i])));
+	    tmp = newSVpvn_flags(pglob.gl_pathv[i], strlen(pglob.gl_pathv[i]),
+				 SVs_TEMP);
 	    TAINT;
 	    SvTAINT(tmp);
 	    PUSHs(tmp);
 	}
+	PUTBACK;
 
 	bsd_globfree(&pglob);
     }
+}
+
+static void
+iterate(pTHX_ bool(*globber)(pTHX_ AV *entries, const char *pat, STRLEN len, bool is_utf8))
+{
+    dSP;
+    dMY_CXT;
+
+    const char * const cxixpv = (char *)&PL_op;
+    STRLEN const cxixlen = sizeof(OP *);
+    AV *entries;
+    U32 const gimme = GIMME_V;
+    SV *patsv = POPs;
+    bool on_stack = FALSE;
+
+    if (!MY_CXT.x_GLOB_ENTRIES) MY_CXT.x_GLOB_ENTRIES = newHV();
+    entries = (AV *)*(hv_fetch(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, 1));
+
+    /* if we're just beginning, do it all first */
+    if (SvTYPE(entries) != SVt_PVAV) {
+        const char *pat;
+        STRLEN len;
+        bool is_utf8;
+
+        /* glob without args defaults to $_ */
+        SvGETMAGIC(patsv);
+        if (
+            !SvOK(patsv)
+              && (patsv = DEFSV, SvGETMAGIC(patsv), !SvOK(patsv))
+            ) {
+            pat = "";
+            len = 0;
+            is_utf8 = 0;
+        }
+        else {
+            pat = SvPV_nomg(patsv,len);
+            is_utf8 = !!SvUTF8(patsv);
+            /* the lower-level code expects a null-terminated string */
+            if (!SvPOK(patsv) || pat != SvPVX(patsv) || pat[len] != '\0') {
+                SV *newpatsv = newSVpvn_flags(pat, len, SVs_TEMP);
+                pat = SvPV_nomg(newpatsv,len);
+            }
+        }
+
+        if (!IS_SAFE_SYSCALL(pat, len, "pattern", "glob")) {
+            if (gimme != G_ARRAY)
+                PUSHs(&PL_sv_undef);
+            PUTBACK;
+            return;
+        }
+
+	PUTBACK;
+	on_stack = globber(aTHX_ entries, pat, len, is_utf8);
+	SPAGAIN;
+    }
+
+    /* chuck it all out, quick or slow */
+    if (gimme == G_ARRAY) {
+	if (!on_stack) {
+	    EXTEND(SP, AvFILLp(entries)+1);
+	    Copy(AvARRAY(entries), SP+1, AvFILLp(entries)+1, SV *);
+	    SP += AvFILLp(entries)+1;
+	}
+	/* No G_DISCARD here!  It will free the stack items. */
+	(void)hv_delete(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, 0);
+    }
+    else {
+	if (AvFILLp(entries) + 1) {
+	    mPUSHs(av_shift(entries));
+	}
+	else {
+	    /* return undef for EOL */
+	    (void)hv_delete(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, G_DISCARD);
+	    PUSHs(&PL_sv_undef);
+	}
+    }
+    PUTBACK;
+}
+
+/* returns true if the items are on the stack already, but only in
+   list context */
+static bool
+csh_glob(pTHX_ AV *entries, const char *pat, STRLEN len, bool is_utf8)
+{
+	dSP;
+	AV *patav = NULL;
+	const char *patend;
+	const char *s = NULL;
+	const char *piece = NULL;
+	SV *word = NULL;
+	SV *flags_sv = get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD);
+	int const flags = (int)SvIV(flags_sv);
+	U32 const gimme = GIMME_V;
+
+	patend = pat + len;
+
+	assert(SvTYPE(entries) != SVt_PVAV);
+	sv_upgrade((SV *)entries, SVt_PVAV);
+
+	/* extract patterns */
+	s = pat-1;
+	while (++s < patend) {
+	    switch (*s) {
+	    case '\'':
+	    case '"' :
+	      {
+		bool found = FALSE;
+		const char quote = *s;
+		if (!word) {
+		    word = newSVpvs("");
+		    if (is_utf8) SvUTF8_on(word);
+		}
+		if (piece) sv_catpvn(word, piece, s-piece);
+		piece = s+1;
+		while (++s < patend)
+		    if (*s == '\\') {
+			s++;
+			/* If the backslash is here to escape a quote,
+			   obliterate it. */
+			if (s < patend && *s == quote)
+			    sv_catpvn(word, piece, s-piece-1), piece = s;
+		    }
+		    else if (*s == quote) {
+			sv_catpvn(word, piece, s-piece);
+			piece = NULL;
+			found = TRUE;
+			break;
+		    }
+		if (!found) { /* unmatched quote */
+		    /* Give up on tokenisation and treat the whole string
+		       as a single token, but with whitespace stripped. */
+		    piece = pat;
+		    while (isSPACE(*pat)) pat++;
+		    while (isSPACE(*(patend-1))) patend--;
+		    /* bsd_glob expects a trailing null, but we cannot mod-
+		       ify the original */
+		    if (patend < pat + len) {
+			if (word) sv_setpvn(word, pat, patend-pat);
+			else
+			    word = newSVpvn_flags(
+				pat, patend-pat, SVf_UTF8*is_utf8
+			    );
+			piece = NULL;
+		    }
+		    else {
+			if (word) SvREFCNT_dec(word), word=NULL;
+			piece = pat;
+			s = patend;
+		    }
+		    goto end_of_parsing;
+		}
+		break;
+	      }
+	    case '\\':
+		if (!piece) piece = s;
+		s++;
+		/* If the backslash is here to escape a quote,
+		   obliterate it. */
+		if (s < patend && (*s == '"' || *s == '\'')) {
+		    if (!word) {
+			word = newSVpvn(piece,s-piece-1);
+			if (is_utf8) SvUTF8_on(word);
+		    }
+		    else sv_catpvn(word, piece, s-piece-1);
+		    piece = s;
+		}
+		break;
+	    default:
+		if (isSPACE(*s)) {
+		    if (piece) {
+			if (!word) {
+			    word = newSVpvn(piece,s-piece);
+			    if (is_utf8) SvUTF8_on(word);
+			}
+			else sv_catpvn(word, piece, s-piece);
+		    }
+		    if (!word) break;
+		    if (!patav) patav = (AV *)sv_2mortal((SV *)newAV());
+		    av_push(patav, word);
+		    word = NULL;
+		    piece = NULL;
+		}
+		else if (!piece) piece = s;
+		break;
+	    }
+	}
+      end_of_parsing:
+
+	if (patav) {
+	    I32 items = AvFILLp(patav) + 1;
+	    SV **svp = AvARRAY(patav);
+	    while (items--) {
+		PUSHMARK(SP);
+		PUTBACK;
+		doglob(aTHX_ SvPVXx(*svp++), flags);
+		SPAGAIN;
+		{
+		    dMARK;
+		    dORIGMARK;
+		    while (++MARK <= SP)
+			av_push(entries, SvREFCNT_inc_simple_NN(*MARK));
+		    SP = ORIGMARK;
+		}
+	    }
+	}
+	/* piece is set at this point if there is no trailing whitespace.
+	   It is the beginning of the last token or quote-delimited
+	   piece thereof.  word is set at this point if the last token has
+	   multiple quoted pieces. */
+	if (piece || word) {
+	    if (word) {
+		if (piece) sv_catpvn(word, piece, s-piece);
+		piece = SvPVX(word);
+	    }
+	    PUSHMARK(SP);
+	    PUTBACK;
+	    doglob(aTHX_ piece, flags);
+	    if (word) SvREFCNT_dec(word);
+	    SPAGAIN;
+	    {
+		dMARK;
+		dORIGMARK;
+		/* short-circuit here for a fairly common case */
+		if (!patav && gimme == G_ARRAY) { PUTBACK; return TRUE; }
+		while (++MARK <= SP)
+		    av_push(entries, SvREFCNT_inc_simple_NN(*MARK));
+
+		SP = ORIGMARK;
+	    }
+	}
+	PUTBACK;
+	return FALSE;
+}
+
+static void
+csh_glob_iter(pTHX)
+{
+    iterate(aTHX_ csh_glob);
+}
+
+/* wrapper around doglob that can be passed to the iterator */
+static bool
+doglob_iter_wrapper(pTHX_ AV *entries, const char *pattern, STRLEN len, bool is_utf8)
+{
+    dSP;
+    SV * flags_sv = get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD);
+    int const flags = (int)SvIV(flags_sv);
+
+    PERL_UNUSED_VAR(len); /* we use \0 termination instead */
+    /* XXX we currently just use the underlying bytes of the passed SV.
+     * Some day someone needs to make glob utf8 aware */
+    PERL_UNUSED_VAR(is_utf8);
+
+    PUSHMARK(SP);
+    PUTBACK;
+    doglob(aTHX_ pattern, flags);
+    SPAGAIN;
+    {
+	dMARK;
+	dORIGMARK;
+	if (GIMME_V == G_ARRAY) { PUTBACK; return TRUE; }
+	sv_upgrade((SV *)entries, SVt_PVAV);
+	while (++MARK <= SP)
+	    av_push(entries, SvREFCNT_inc_simple_NN(*MARK));
+	SP = ORIGMARK;
+    }
+    return FALSE;
+}
+
+static void
+glob_ophook(pTHX_ OP *o)
+{
+  if (PL_dirty) return;
+  {
+    dMY_CXT;
+    if (MY_CXT.x_GLOB_ENTRIES
+     && (o->op_type == OP_GLOB || o->op_type == OP_ENTERSUB))
+	(void)hv_delete(MY_CXT.x_GLOB_ENTRIES, (char *)&o, sizeof(OP *),
+		  G_DISCARD);
+    if (MY_CXT.x_GLOB_OLD_OPHOOK) MY_CXT.x_GLOB_OLD_OPHOOK(aTHX_ o);
+  }
+}
+
+MODULE = File::Glob		PACKAGE = File::Glob
+
+int
+GLOB_ERROR()
+    PREINIT:
+	dMY_CXT;
+    CODE:
+	RETVAL = GLOB_ERROR;
+    OUTPUT:
+	RETVAL
+
+void
+bsd_glob(pattern_sv,...)
+    SV *pattern_sv
+PREINIT:
+    int flags = 0;
+    char *pattern;
+    STRLEN len;
+PPCODE:
+    {
+        pattern = SvPV(pattern_sv, len);
+        if (!IS_SAFE_SYSCALL(pattern, len, "pattern", "bsd_glob"))
+            XSRETURN(0);
+	/* allow for optional flags argument */
+	if (items > 1) {
+	    flags = (int) SvIV(ST(1));
+	    /* remove unsupported flags */
+	    flags &= ~(GLOB_APPEND | GLOB_DOOFFS | GLOB_ALTDIRFUNC | GLOB_MAGCHAR);
+	} else {
+	    SV * flags_sv = get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD);
+	    flags = (int)SvIV(flags_sv);
+	}
+	
+	PUTBACK;
+	doglob(aTHX_ pattern, flags);
+	SPAGAIN;
+    }
+
+PROTOTYPES: DISABLE
+void
+csh_glob(...)
+PPCODE:
+    /* For backward-compatibility with the original Perl function, we sim-
+     * ply take the first argument, regardless of how many there are.
+     */
+    if (items) SP ++;
+    else {
+	XPUSHs(&PL_sv_undef);
+    }
+    PUTBACK;
+    csh_glob_iter(aTHX);
+    SPAGAIN;
+
+void
+bsd_glob_override(...)
+PPCODE:
+    if (items) SP ++;
+    else {
+	XPUSHs(&PL_sv_undef);
+    }
+    PUTBACK;
+    iterate(aTHX_ doglob_iter_wrapper);
+    SPAGAIN;
+
+#ifdef USE_ITHREADS
+
+void
+CLONE(...)
+INIT:
+    HV *glob_entries_clone = NULL;
+CODE:
+    PERL_UNUSED_ARG(items);
+    {
+        dMY_CXT;
+        if ( MY_CXT.x_GLOB_ENTRIES ) {
+            CLONE_PARAMS param;
+            param.stashes    = NULL;
+            param.flags      = 0;
+            param.proto_perl = MY_CXT.interp;
+            
+            glob_entries_clone = MUTABLE_HV(sv_dup_inc((SV*)MY_CXT.x_GLOB_ENTRIES, &param));
+        }
+    }
+    {
+        MY_CXT_CLONE;
+        MY_CXT.x_GLOB_ENTRIES = glob_entries_clone;
+        MY_CXT.interp = aTHX;
+    }
+
+#endif
+
+BOOT:
+{
+#ifndef PERL_EXTERNAL_GLOB
+    /* Don't do this at home! The globhook interface is highly volatile. */
+    PL_globhook = csh_glob_iter;
+#endif
+}
+
+BOOT:
+{
+    MY_CXT_INIT;
+    {
+	dMY_CXT;
+	MY_CXT.x_GLOB_ENTRIES = NULL;
+	MY_CXT.x_GLOB_OLD_OPHOOK = PL_opfreehook;
+#ifdef USE_ITHREADS
+        MY_CXT.interp = aTHX;
+#endif
+	PL_opfreehook = glob_ophook;
+    }  
+}
 
 INCLUDE: const-xs.inc
diff --git a/gnu/usr.bin/perl/ext/File-Glob/bsd_glob.c b/gnu/usr.bin/perl/ext/File-Glob/bsd_glob.c
index 2ba0d494071..821ef200ad6 100644
--- a/gnu/usr.bin/perl/ext/File-Glob/bsd_glob.c
+++ b/gnu/usr.bin/perl/ext/File-Glob/bsd_glob.c
@@ -602,6 +602,7 @@ glob0(const Char *pattern, glob_t *pglob)
 		return(globextend(qpat, pglob, &limit));
         }
 	else if (!(pglob->gl_flags & GLOB_NOSORT))
+            if (pglob->gl_pathv)
 		qsort(pglob->gl_pathv + pglob->gl_offs + oldpathc,
 		    pglob->gl_pathc - oldpathc, sizeof(char *),
 		    (pglob->gl_flags & (GLOB_ALPHASORT|GLOB_NOCASE))
diff --git a/gnu/usr.bin/perl/ext/File-Glob/t/rt114984.t b/gnu/usr.bin/perl/ext/File-Glob/t/rt114984.t
index 285bb70e957..43e90d7508c 100644
--- a/gnu/usr.bin/perl/ext/File-Glob/t/rt114984.t
+++ b/gnu/usr.bin/perl/ext/File-Glob/t/rt114984.t
@@ -16,16 +16,26 @@ my @mp = (1000..1205);
 
 my $path = tempdir uc cleanup => 1;
 
+my $md = 0;
+my $mp = 0;
+
 foreach (@md) {
-    open(my $f, ">", catfile $path, "md_$_.dat");
-    close $f;
+    if (open(my $f, ">", catfile $path, "md_$_.dat")) {
+        $md++;
+        close $f;
+    }
 }
 
 foreach (@mp) {
-    open(my $f, ">", catfile $path, "mp_$_.dat");
-    close $f;
+    if (open(my $f, ">", catfile $path, "mp_$_.dat")) {
+        $mp++;
+        close $f;
+    }
+}
+my @b = glob(qq{$path/mp_[0123456789]*.dat $path/md_[0123456789]*.dat});
+if ($md+$mp < @md+@mp) {
+   warn sprintf("$0: expected to create %d files, created only %d (path $path)\n",
+                @md+@mp, $md+$mp);
 }
-my @b = glob(qq{$path/mp_[0123456789]*.dat
-                $path/md_[0123456789]*.dat});
-is scalar(@b), @md+@mp,
+is scalar(@b), $md+$mp,
     'File::Glob extends the stack when returning a long list';