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 (file)
--- 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 (file)
--- 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 a21fe84..ee8c0c9 100644 (file)
--- 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 (file)
--- 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 10d1de5..5d04fff 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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