From: Jarkko Hietaniemi Date: Wed, 21 Mar 2001 00:46:14 +0000 (+0000) Subject: Integrate changes #9262,9264,9265,9266 from maintperl to mainline. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2d5e9e5d1dfda924cd025894f9c8781ba03c3c8c;p=p5sagit%2Fp5-mst-13.2.git Integrate changes #9262,9264,9265,9266 from maintperl to mainline. revert the leak fix in change#9142 (problem needs a more experimental fix unsuitable for 5.6.1) do alphabetical sorting by default (for csh compatibility) cut-n-paste goof in change#9264 VMS piping fixes (from Charles Lane) p4raw-link: @9266 on //depot/maint-5.6/perl: 72d1c956969523b19a71b5ffb5af9479f09d0e6a p4raw-link: @9265 on //depot/maint-5.6/perl: 8549c3fc2da30e970df00a46a796a39e843777aa p4raw-link: @9264 on //depot/maint-5.6/perl: 1086ad2319c3ee3e3873c478e76309ea4f03453b p4raw-link: @9262 on //depot/maint-5.6/perl: a89eb504d1201e0dad09aaf86db07d000904f216 p4raw-link: @9142 on //depot/maint-5.6/perl: 26972843796e21c404c9d13ec5ee86e7b952a2bd p4raw-id: //depot/perl@9269 p4raw-integrated: from //depot/maint-5.6/perl@9268 'copy in' ext/File/Glob/Changes ext/File/Glob/bsd_glob.c ext/File/Glob/bsd_glob.h (@5902..) ext/File/Glob/Glob.pm (@7770..) vms/vmspipe.com (@8636..) vms/vms.c (@8986..) 'edit in' ext/File/Glob/Glob.xs (@9264..) 'merge in' scope.c (@9142..) --- diff --git a/ext/File/Glob/Changes b/ext/File/Glob/Changes index e246c6d..f46ec70 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 57bfa0d..76adbe7 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 For convenience, C is a synonym for -C. +C. =back @@ -297,6 +305,18 @@ extensions C, and C 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 + +If C 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 a21fe84..ee8c0c9 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 62bfe4f..55f8312 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 @@ -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 10d1de5..5d04fff 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 106b3dc..3293c48 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 7915679..f63bbde 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 652783e..28caa74 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