summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ext/File/Glob/Changes2
-rw-r--r--ext/File/Glob/Glob.pm24
-rw-r--r--ext/File/Glob/Glob.xs6
-rw-r--r--ext/File/Glob/bsd_glob.c6
-rw-r--r--ext/File/Glob/bsd_glob.h1
-rw-r--r--scope.c18
-rw-r--r--vms/vms.c6
-rw-r--r--vms/vmspipe.com4
8 files changed, 52 insertions, 15 deletions
diff --git a/ext/File/Glob/Changes b/ext/File/Glob/Changes
index e246c6d684..f46ec704e9 100644
--- a/ext/File/Glob/Changes
+++ b/ext/File/Glob/Changes
@@ -45,3 +45,5 @@ Revision history for Perl extension File::Glob
- Add support for either \ or / as separators on DOSISH systems
- Limit effect of \ as a quoting operator on DOSISH systems to
when it precedes one of []{}-~\ (to minimise backslashitis).
+0.992 Tue Mar 20 09:25:48 2001
+ - Add alphabetic sorting for csh compatibility (GLOB_ALPHASORT)
diff --git a/ext/File/Glob/Glob.pm b/ext/File/Glob/Glob.pm
index 57bfa0d1c1..76adbe7b3d 100644
--- a/ext/File/Glob/Glob.pm
+++ b/ext/File/Glob/Glob.pm
@@ -19,6 +19,7 @@ require AutoLoader;
bsd_glob
glob
GLOB_ABEND
+ GLOB_ALPHASORT
GLOB_ALTDIRFUNC
GLOB_BRACE
GLOB_CSH
@@ -37,6 +38,7 @@ require AutoLoader;
%EXPORT_TAGS = (
'glob' => [ qw(
GLOB_ABEND
+ GLOB_ALPHASORT
GLOB_ALTDIRFUNC
GLOB_BRACE
GLOB_CSH
@@ -104,7 +106,13 @@ sub GLOB_ERROR {
return constant('GLOB_ERROR', 0);
}
-sub GLOB_CSH () { GLOB_BRACE() | GLOB_NOMAGIC() | GLOB_QUOTE() | GLOB_TILDE() }
+sub GLOB_CSH () {
+ GLOB_BRACE()
+ | GLOB_NOMAGIC()
+ | GLOB_QUOTE()
+ | GLOB_TILDE()
+ | GLOB_ALPHASORT()
+}
$DEFAULT_FLAGS = GLOB_CSH();
if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos|MacOS)$/) {
@@ -288,7 +296,7 @@ Expand patterns that start with '~' to user name home directories.
=item C<GLOB_CSH>
For convenience, C<GLOB_CSH> is a synonym for
-C<GLOB_BRACE | GLOB_NOMAGIC | GLOB_QUOTE | GLOB_TILDE>.
+C<GLOB_BRACE | GLOB_NOMAGIC | GLOB_QUOTE | GLOB_TILDE | GLOB_ALPHASORT>.
=back
@@ -297,6 +305,18 @@ extensions C<GLOB_ALTDIRFUNC>, and C<GLOB_MAGCHAR> flags have not been
implemented in the Perl version because they involve more complex
interaction with the underlying C structures.
+The following flag has been added in the Perl implementation for
+csh compatibility:
+
+=over 4
+
+=item C<GLOB_ALPHASORT>
+
+If C<GLOB_NOSORT> is not in effect, sort filenames is alphabetical
+order (case does not matter) rather than in ASCII order.
+
+=back
+
=head1 DIAGNOSTICS
bsd_glob() returns a list of matching paths, possibly zero length. If an
diff --git a/ext/File/Glob/Glob.xs b/ext/File/Glob/Glob.xs
index a21fe84f35..ee8c0c9751 100644
--- a/ext/File/Glob/Glob.xs
+++ b/ext/File/Glob/Glob.xs
@@ -21,6 +21,12 @@ constant(char *name, int arg)
#else
goto not_there;
#endif
+ if (strEQ(name, "GLOB_ALPHASORT"))
+#ifdef GLOB_ALPHASORT
+ return GLOB_ALPHASORT;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "GLOB_ALTDIRFUNC"))
#ifdef GLOB_ALTDIRFUNC
return GLOB_ALTDIRFUNC;
diff --git a/ext/File/Glob/bsd_glob.c b/ext/File/Glob/bsd_glob.c
index 62bfe4f80c..55f8312186 100644
--- a/ext/File/Glob/bsd_glob.c
+++ b/ext/File/Glob/bsd_glob.c
@@ -57,6 +57,9 @@ static char sccsid[] = "@(#)glob.c 8.3 (Berkeley) 10/13/93";
* expand {1,2}{a,b} to 1a 1b 2a 2b
* gl_matchc:
* Number of matches in the current invocation of glob.
+ * GLOB_ALPHASORT:
+ * sort alphabetically like csh (case doesn't matter) instead of in ASCII
+ * order
*/
#include <EXTERN.h>
@@ -531,7 +534,8 @@ glob0(const Char *pattern, glob_t *pglob)
else if (!(pglob->gl_flags & GLOB_NOSORT))
qsort(pglob->gl_pathv + pglob->gl_offs + oldpathc,
pglob->gl_pathc - oldpathc, sizeof(char *),
- (pglob->gl_flags & GLOB_NOCASE) ? ci_compare : compare);
+ (pglob->gl_flags & (GLOB_ALPHASORT|GLOB_NOCASE))
+ ? ci_compare : compare);
pglob->gl_flags = oldflags;
return(0);
}
diff --git a/ext/File/Glob/bsd_glob.h b/ext/File/Glob/bsd_glob.h
index 10d1de534c..5d04fff1c3 100644
--- a/ext/File/Glob/bsd_glob.h
+++ b/ext/File/Glob/bsd_glob.h
@@ -72,6 +72,7 @@ typedef struct {
#define GLOB_QUOTE 0x0400 /* Quote special chars with \. */
#define GLOB_TILDE 0x0800 /* Expand tilde names from the passwd file. */
#define GLOB_NOCASE 0x1000 /* Treat filenames without regard for case. */
+#define GLOB_ALPHASORT 0x2000 /* Alphabetic, not ASCII sort, like csh. */
#define GLOB_NOSPACE (-1) /* Malloc call failed. */
#define GLOB_ABEND (-2) /* Unignored error. */
diff --git a/scope.c b/scope.c
index 106b3dc253..3293c4862d 100644
--- a/scope.c
+++ b/scope.c
@@ -207,6 +207,9 @@ S_save_scalar_at(pTHX_ SV **sptr)
}
SvMAGIC(sv) = SvMAGIC(osv);
SvFLAGS(sv) |= SvMAGICAL(osv);
+ /* XXX SvMAGIC() is *shared* between osv and sv. This can
+ * lead to coredumps when both SVs are destroyed without one
+ * of their SvMAGIC() slots being NULLed. */
PL_localizing = 1;
SvSETMAGIC(sv);
PL_localizing = 0;
@@ -678,19 +681,20 @@ Perl_leave_scope(pTHX_ I32 base)
SvMAGICAL_off(sv);
SvMAGIC(sv) = 0;
}
- /* XXX this branch is pretty bogus--note that we seem to
- * only get here if the mg_get() in save_scalar_at() ends
- * up croaking. This code irretrievably clears(!) the magic
- * on the SV to avoid further croaking that might ensue
- * when the SvSETMAGIC() below is called. This needs a
- * total rethink. --GSAR */
+ /* XXX This branch is pretty bogus. This code irretrievably
+ * clears(!) the magic on the SV (either to avoid further
+ * croaking that might ensue when the SvSETMAGIC() below is
+ * called, or to avoid two different SVs pointing at the same
+ * SvMAGIC()). This needs a total rethink. --GSAR */
else if (SvTYPE(value) >= SVt_PVMG && SvMAGIC(value) &&
SvTYPE(value) != SVt_PVGV)
{
SvFLAGS(value) |= (SvFLAGS(value) &
(SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
SvMAGICAL_off(value);
- mg_free(value);
+ /* XXX this is a leak when we get here because the
+ * mg_get() in save_scalar_at() croaked */
+ SvMAGIC(value) = 0;
}
SvREFCNT_dec(sv);
*(SV**)ptr = value;
diff --git a/vms/vms.c b/vms/vms.c
index 7915679068..f63bbde361 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -759,7 +759,7 @@ Perl_vmssetuserlnm(char *name, char *eqv)
{
$DESCRIPTOR(d_tab, "LNM$PROCESS");
struct dsc$descriptor_d d_name = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0};
- unsigned long int iss, attr = 0;
+ unsigned long int iss, attr = LNM$M_CONFINE;
unsigned char acmode = PSL$C_USER;
struct itmlst_3 lnmlst[2] = {{0, LNM$_STRING, 0, 0},
{0, 0, 0, 0}};
@@ -1898,8 +1898,8 @@ vmspipe_tempfile(void)
fprintf(fp,"$ perl_del = \"delete\"\n");
fprintf(fp,"$ pif = \"if\"\n");
fprintf(fp,"$! --- define i/o redirection (sys$output set by lib$spawn)\n");
- fprintf(fp,"$ pif perl_popen_in .nes. \"\" then perl_define/user sys$input 'perl_popen_in'\n");
- fprintf(fp,"$ pif perl_popen_err .nes. \"\" then perl_define/user sys$error 'perl_popen_err'\n");
+ fprintf(fp,"$ pif perl_popen_in .nes. \"\" then perl_define/user/name_attributes=confine sys$input 'perl_popen_in'\n");
+ fprintf(fp,"$ pif perl_popen_err .nes. \"\" then perl_define/user/name_attributes=confine sys$error 'perl_popen_err'\n");
fprintf(fp,"$ pif perl_popen_out .nes. \"\" then perl_define sys$output 'perl_popen_out'\n");
fprintf(fp,"$ cmd = perl_popen_cmd\n");
fprintf(fp,"$! --- get rid of global symbols\n");
diff --git a/vms/vmspipe.com b/vms/vmspipe.com
index 652783eec5..28caa745e7 100644
--- a/vms/vmspipe.com
+++ b/vms/vmspipe.com
@@ -6,8 +6,8 @@ $ perl_exit = "exit"
$ perl_del = "delete"
$ pif = "if"
$! --- define i/o redirection (sys$output set by lib$spawn)
-$ pif perl_popen_in .nes. "" then perl_define/user sys$input 'perl_popen_in'
-$ pif perl_popen_err .nes. "" then perl_define/user sys$error 'perl_popen_err'
+$ pif perl_popen_in .nes. "" then perl_define/user/name_attributes=confine sys$input 'perl_popen_in'
+$ pif perl_popen_err .nes. "" then perl_define/user/name_attributes=confine sys$error 'perl_popen_err'
$ pif perl_popen_out .nes. "" then perl_define sys$output 'perl_popen_out'
$ cmd = perl_popen_cmd
$! --- get rid of global symbols
View Lorry Controller Status