This patch describes the changes made in ActivePerl build 629 over the official Perl v5.6.1 sources from CPAN. Summary of changes in build 629: * Make "perl -V" output reflect ActiveState build. * Add Win32::BuildNumber() for compatibility. * Add resources to perl.exe and perl56.dll. The ActivePerl Release Notes contain an informal summary of these changes. These can be viewed at: http://www.ActiveState.com/ActivePerl/docs/CHANGES.html The included patch may be applied to Perl v5.6.1 sources using the GNU patch utility. e.g: % cd perl-5.6.1 % patch -lNp1 < this_file --------------------------------------------------------------------------- diff -ruN perl-5.6.1/BuildInfo.h AP629_source/BuildInfo.h --- perl-5.6.1/BuildInfo.h Wed Dec 31 16:00:00 1969 +++ AP629_source/BuildInfo.h Thu Aug 23 17:30:19 2001 @@ -0,0 +1,25 @@ +/* BuildInfo.h + * + * (c) 1998 ActiveState Tool Corp. All rights reserved. + * + */ + +#ifndef ___BuildInfo__h___ +#define ___BuildInfo__h___ + +#define PRODUCT_BUILD_NUMBER "629" +#define PERLFILEVERSION "5,6,1,629\0" +#define PERLRC_VERSION 5,6,1,629 +#define ACTIVEPERL_CHANGELIST "" +#define PERLPRODUCTVERSION "Build " PRODUCT_BUILD_NUMBER ACTIVEPERL_CHANGELIST "\0" +#define PERLPRODUCTNAME "ActivePerl\0" + +#define PERL_VENDORLIB_NAME "ActiveState" + +#define ACTIVEPERL_VERSION "Built "##__TIME__##" "##__DATE__##"\n" +#define ACTIVEPERL_LOCAL_PATCHES_ENTRY "ActivePerl Build " PRODUCT_BUILD_NUMBER ACTIVEPERL_CHANGELIST +#define BINARY_BUILD_NOTICE printf("\n\ +Binary build " PRODUCT_BUILD_NUMBER ACTIVEPERL_CHANGELIST " provided by ActiveState Tool Corp. http://www.ActiveState.com\n\ +" ACTIVEPERL_VERSION "\n"); + +#endif /* ___BuildInfo__h___ */ diff -ruN perl-5.6.1/Configure AP629_source/Configure --- perl-5.6.1/Configure Sun Mar 18 19:03:33 2001 +++ AP629_source/Configure Thu Aug 23 17:30:21 2001 @@ -6357,7 +6357,7 @@ fi ;; $undef) dflt='none' ;; -*) dflt="$inc_version_list" ;; +*) dflt=`echo $inc_version_list|sed 's,$archname,'$archname',g'` ;; esac case "$dflt" in ''|' ') dflt=none ;; diff -ruN perl-5.6.1/MANIFEST AP629_source/MANIFEST --- perl-5.6.1/MANIFEST Sun Apr 8 11:38:40 2001 +++ AP629_source/MANIFEST Thu Aug 23 17:30:21 2001 @@ -1470,6 +1470,7 @@ t/op/numconvert.t See if accessing fields does not change numeric values t/op/oct.t See if oct and hex work t/op/ord.t See if ord works +t/op/override.t See if operator overriding works t/op/pack.t See if pack and unpack work t/op/pat.t See if esoteric patterns work t/op/pos.t See if pos works diff -ruN perl-5.6.1/av.c AP629_source/av.c --- perl-5.6.1/av.c Wed Mar 21 21:05:02 2001 +++ AP629_source/av.c Thu Aug 23 17:30:21 2001 @@ -760,6 +760,7 @@ else { sv = AvARRAY(av)[key]; if (key == AvFILLp(av)) { + AvARRAY(av)[key] = &PL_sv_undef; do { AvFILLp(av)--; } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef); diff -ruN perl-5.6.1/cop.h AP629_source/cop.h --- perl-5.6.1/cop.h Wed Mar 21 21:05:02 2001 +++ AP629_source/cop.h Thu Aug 23 17:30:21 2001 @@ -155,6 +155,7 @@ SV * old_namesv; OP * old_eval_root; SV * cur_text; + CV * cv; }; #define PUSHEVAL(cx,n,fgv) \ @@ -164,6 +165,7 @@ cx->blk_eval.old_namesv = (n ? newSVpv(n,0) : Nullsv); \ cx->blk_eval.old_eval_root = PL_eval_root; \ cx->blk_eval.cur_text = PL_linestr; \ + cx->blk_eval.cv = Nullcv; /* set by doeval(), as applicable */ \ } STMT_END #define POPEVAL(cx) \ diff -ruN perl-5.6.1/doop.c AP629_source/doop.c --- perl-5.6.1/doop.c Thu Apr 5 21:38:46 2001 +++ AP629_source/doop.c Thu Aug 23 17:30:21 2001 @@ -932,6 +932,7 @@ { register I32 count; STRLEN len; + STRLEN n_a; char *s; if (RsSNARF(PL_rs)) @@ -963,8 +964,6 @@ else if (SvREADONLY(sv)) Perl_croak(aTHX_ PL_no_modify); s = SvPV(sv, len); - if (len && !SvPOKp(sv)) - s = SvPV_force(sv, len); if (s && len) { s += --len; if (RsPARA(PL_rs)) { @@ -995,12 +994,13 @@ count += rslen; } } - *s = '\0'; + s = SvPV_force(sv, n_a); SvCUR_set(sv, len); + *SvEND(sv) = '\0'; SvNIOK_off(sv); + SvSETMAGIC(sv); } nope: - SvSETMAGIC(sv); return count; } diff -ruN perl-5.6.1/embed.h AP629_source/embed.h --- perl-5.6.1/embed.h Thu Apr 5 21:38:46 2001 +++ AP629_source/embed.h Thu Aug 23 17:30:22 2001 @@ -1160,7 +1160,6 @@ #define ck_exit Perl_ck_exit #define ck_ftst Perl_ck_ftst #define ck_fun Perl_ck_fun -#define ck_fun_locale Perl_ck_fun_locale #define ck_glob Perl_ck_glob #define ck_grep Perl_ck_grep #define ck_index Perl_ck_index @@ -1178,7 +1177,6 @@ #define ck_rfun Perl_ck_rfun #define ck_rvconst Perl_ck_rvconst #define ck_sassign Perl_ck_sassign -#define ck_scmp Perl_ck_scmp #define ck_select Perl_ck_select #define ck_shift Perl_ck_shift #define ck_sort Perl_ck_sort @@ -2619,7 +2617,6 @@ #define ck_exit(a) Perl_ck_exit(aTHX_ a) #define ck_ftst(a) Perl_ck_ftst(aTHX_ a) #define ck_fun(a) Perl_ck_fun(aTHX_ a) -#define ck_fun_locale(a) Perl_ck_fun_locale(aTHX_ a) #define ck_glob(a) Perl_ck_glob(aTHX_ a) #define ck_grep(a) Perl_ck_grep(aTHX_ a) #define ck_index(a) Perl_ck_index(aTHX_ a) @@ -2637,7 +2634,6 @@ #define ck_rfun(a) Perl_ck_rfun(aTHX_ a) #define ck_rvconst(a) Perl_ck_rvconst(aTHX_ a) #define ck_sassign(a) Perl_ck_sassign(aTHX_ a) -#define ck_scmp(a) Perl_ck_scmp(aTHX_ a) #define ck_select(a) Perl_ck_select(aTHX_ a) #define ck_shift(a) Perl_ck_shift(aTHX_ a) #define ck_sort(a) Perl_ck_sort(aTHX_ a) @@ -3004,11 +3000,11 @@ # if defined(PERL_IMPLICIT_SYS) # endif #endif -#if defined(MYMALLOC) #define malloc Perl_malloc #define calloc Perl_calloc #define realloc Perl_realloc #define mfree Perl_mfree +#if defined(MYMALLOC) #define malloced_size Perl_malloced_size #endif #define get_context Perl_get_context @@ -5082,8 +5078,6 @@ #define ck_ftst Perl_ck_ftst #define Perl_ck_fun CPerlObj::Perl_ck_fun #define ck_fun Perl_ck_fun -#define Perl_ck_fun_locale CPerlObj::Perl_ck_fun_locale -#define ck_fun_locale Perl_ck_fun_locale #define Perl_ck_glob CPerlObj::Perl_ck_glob #define ck_glob Perl_ck_glob #define Perl_ck_grep CPerlObj::Perl_ck_grep @@ -5118,8 +5112,6 @@ #define ck_rvconst Perl_ck_rvconst #define Perl_ck_sassign CPerlObj::Perl_ck_sassign #define ck_sassign Perl_ck_sassign -#define Perl_ck_scmp CPerlObj::Perl_ck_scmp -#define ck_scmp Perl_ck_scmp #define Perl_ck_select CPerlObj::Perl_ck_select #define ck_select Perl_ck_select #define Perl_ck_shift CPerlObj::Perl_ck_shift diff -ruN perl-5.6.1/embed.pl AP629_source/embed.pl --- perl-5.6.1/embed.pl Thu Apr 5 21:38:46 2001 +++ AP629_source/embed.pl Thu Aug 23 17:30:22 2001 @@ -1354,11 +1354,11 @@ # endif #endif -#if defined(MYMALLOC) Ajnop |Malloc_t|malloc |MEM_SIZE nbytes Ajnop |Malloc_t|calloc |MEM_SIZE elements|MEM_SIZE size Ajnop |Malloc_t|realloc |Malloc_t where|MEM_SIZE nbytes Ajnop |Free_t |mfree |Malloc_t where +#if defined(MYMALLOC) jnp |MEM_SIZE|malloced_size |void *p #endif diff -ruN perl-5.6.1/ext/File/Glob/Glob.pm AP629_source/ext/File/Glob/Glob.pm --- perl-5.6.1/ext/File/Glob/Glob.pm Sun Apr 1 22:18:41 2001 +++ AP629_source/ext/File/Glob/Glob.pm Thu Aug 23 17:30:22 2001 @@ -25,6 +25,7 @@ GLOB_CSH GLOB_ERR GLOB_ERROR + GLOB_LIMIT GLOB_MARK GLOB_NOCASE GLOB_NOCHECK @@ -44,6 +45,7 @@ GLOB_CSH GLOB_ERR GLOB_ERROR + GLOB_LIMIT GLOB_MARK GLOB_NOCASE GLOB_NOCHECK @@ -57,7 +59,7 @@ ) ], ); -$VERSION = '0.991'; +$VERSION = '1.0'; sub import { my $i = 1; @@ -241,6 +243,15 @@ Force bsd_glob() to return an error when it encounters a directory it cannot open or read. Ordinarily bsd_glob() continues to find matches. + +=item C + +Make bsd_glob() return an error (GLOB_NOSPACE) when the pattern expands +to a size bigger than the system constant C (usually found in +limits.h). If your system does not define this constant, bsd_glob() uses +C or C<_POSIX_ARG_MAX> where available (in that +order). You can inspect these values using the standard C +extension. =item C diff -ruN perl-5.6.1/ext/File/Glob/Glob.xs AP629_source/ext/File/Glob/Glob.xs --- perl-5.6.1/ext/File/Glob/Glob.xs Thu Apr 5 21:38:46 2001 +++ AP629_source/ext/File/Glob/Glob.xs Thu Aug 23 17:30:22 2001 @@ -69,6 +69,12 @@ case 'K': break; case 'L': + if (strEQ(name, "GLOB_LIMIT")) +#ifdef GLOB_LIMIT + return GLOB_LIMIT; +#else + goto not_there; +#endif break; case 'M': if (strEQ(name, "GLOB_MARK")) diff -ruN perl-5.6.1/ext/File/Glob/bsd_glob.c AP629_source/ext/File/Glob/bsd_glob.c --- perl-5.6.1/ext/File/Glob/bsd_glob.c Sun Apr 1 22:18:41 2001 +++ AP629_source/ext/File/Glob/bsd_glob.c Thu Aug 23 17:30:22 2001 @@ -32,6 +32,9 @@ #if defined(LIBC_SCCS) && !defined(lint) static char sccsid[] = "@(#)glob.c 8.3 (Berkeley) 10/13/93"; +/* most changes between the version above and the one below have been ported: +static char sscsid[]= "$OpenBSD: glob.c,v 1.8.10.1 2001/04/10 jason Exp $"; + */ #endif /* LIBC_SCCS and not lint */ /* @@ -87,6 +90,26 @@ # endif #endif +#ifdef I_LIMITS +#include +#endif + +#ifndef ARG_MAX +# ifdef _SC_ARG_MAX +# define ARG_MAX (sysconf(_SC_ARG_MAX)) +# else +# ifdef _POSIX_ARG_MAX +# define ARG_MAX _POSIX_ARG_MAX +# else +# ifdef WIN32 +# define ARG_MAX 14500 /* from VC's limits.h */ +# else +# define ARG_MAX 4096 /* from POSIX, be conservative */ +# endif +# endif +# endif +#endif + #define BG_DOLLAR '$' #define BG_DOT '.' #define BG_EOS '\0' @@ -146,20 +169,20 @@ static int compare(const void *, const void *); static int ci_compare(const void *, const void *); -static void g_Ctoc(const Char *, char *); +static int g_Ctoc(const Char *, char *, STRLEN); static int g_lstat(Char *, Stat_t *, glob_t *); static DIR *g_opendir(Char *, glob_t *); static Char *g_strchr(Char *, int); -#ifdef notdef -static Char *g_strcat(Char *, const Char *); -#endif static int g_stat(Char *, Stat_t *, glob_t *); static int glob0(const Char *, glob_t *); -static int glob1(Char *, glob_t *); -static int glob2(Char *, Char *, Char *, glob_t *); -static int glob3(Char *, Char *, Char *, Char *, glob_t *); -static int globextend(const Char *, glob_t *); -static const Char * globtilde(const Char *, Char *, glob_t *); +static int glob1(Char *, Char *, glob_t *, size_t *); +static int glob2(Char *, Char *, Char *, Char *, Char *, Char *, + glob_t *, size_t *); +static int glob3(Char *, Char *, Char *, Char *, Char *, Char *, + Char *, Char *, glob_t *, size_t *); +static int globextend(const Char *, glob_t *, size_t *); +static const Char * + globtilde(const Char *, Char *, size_t, glob_t *); static int globexp1(const Char *, glob_t *); static int globexp2(const Char *, const Char *, glob_t *, int *); static int match(Char *, Char *, Char *, int); @@ -185,7 +208,7 @@ { const U8 *patnext; int c; - Char *bufnext, *bufend, patbuf[MAXPATHLEN+1]; + Char *bufnext, *bufend, patbuf[MAXPATHLEN]; patnext = (U8 *) pattern; if (!(flags & GLOB_APPEND)) { @@ -199,7 +222,7 @@ pglob->gl_matchc = 0; bufnext = patbuf; - bufend = bufnext + MAXPATHLEN; + bufend = bufnext + MAXPATHLEN - 1; #ifdef DOSISH /* Nasty hack to treat patterns like "C:*" correctly. In this * case, the * should match any file in the current directory @@ -239,13 +262,11 @@ --patnext; } *bufnext++ = c | M_PROTECT; - } - else + } else *bufnext++ = c; - } - else - while (bufnext < bufend && (c = *patnext++) != BG_EOS) - *bufnext++ = c; + } else + while (bufnext < bufend && (c = *patnext++) != BG_EOS) + *bufnext++ = c; *bufnext = BG_EOS; if (flags & GLOB_BRACE) @@ -259,7 +280,8 @@ * invoke the standard globbing routine to glob the rest of the magic * characters */ -static int globexp1(const Char *pattern, glob_t *pglob) +static int +globexp1(const Char *pattern, glob_t *pglob) { const Char* ptr = pattern; int rv; @@ -281,17 +303,19 @@ * If it succeeds then it invokes globexp1 with the new pattern. * If it fails then it tries to glob the rest of the pattern and returns. */ -static int globexp2(const Char *ptr, const Char *pattern, - glob_t *pglob, int *rv) +static int +globexp2(const Char *ptr, const Char *pattern, + glob_t *pglob, int *rv) { int i; Char *lm, *ls; const Char *pe, *pm, *pl; - Char patbuf[MAXPATHLEN + 1]; + Char patbuf[MAXPATHLEN]; /* copy part up to the brace */ for (lm = patbuf, pm = pattern; pm != ptr; *lm++ = *pm++) - continue; + ; + *lm = BG_EOS; ls = lm; /* Find the balanced brace */ @@ -299,7 +323,7 @@ if (*pe == BG_LBRACKET) { /* Ignore everything between [] */ for (pm = pe++; *pe != BG_RBRACKET && *pe != BG_EOS; pe++) - continue; + ; if (*pe == BG_EOS) { /* * We could not find a matching BG_RBRACKET. @@ -307,8 +331,7 @@ */ pe = pm; } - } - else if (*pe == BG_LBRACE) + } else if (*pe == BG_LBRACE) i++; else if (*pe == BG_RBRACE) { if (i == 0) @@ -322,12 +345,12 @@ return 0; } - for (i = 0, pl = pm = ptr; pm <= pe; pm++) + for (i = 0, pl = pm = ptr; pm <= pe; pm++) { switch (*pm) { case BG_LBRACKET: /* Ignore everything between [] */ for (pl = pm++; *pm != BG_RBRACKET && *pm != BG_EOS; pm++) - continue; + ; if (*pm == BG_EOS) { /* * We could not find a matching BG_RBRACKET. @@ -343,8 +366,8 @@ case BG_RBRACE: if (i) { - i--; - break; + i--; + break; } /* FALLTHROUGH */ case BG_COMMA: @@ -353,13 +376,14 @@ else { /* Append the current string */ for (lm = ls; (pl < pm); *lm++ = *pl++) - continue; + ; + /* * Append the rest of the pattern after the * closing brace */ - for (pl = pe + 1; (*lm++ = *pl++) != BG_EOS;) - continue; + for (pl = pe + 1; (*lm++ = *pl++) != BG_EOS; ) + ; /* Expand the current pattern */ #ifdef GLOB_DEBUG @@ -375,6 +399,7 @@ default: break; } + } *rv = 0; return 0; } @@ -385,23 +410,29 @@ * expand tilde from the passwd file. */ static const Char * -globtilde(const Char *pattern, Char *patbuf, glob_t *pglob) +globtilde(const Char *pattern, Char *patbuf, size_t patbuf_len, glob_t *pglob) { struct passwd *pwd; char *h; const Char *p; - Char *b; + Char *b, *eb; if (*pattern != BG_TILDE || !(pglob->gl_flags & GLOB_TILDE)) return pattern; /* Copy up to the end of the string or / */ - for (p = pattern + 1, h = (char *) patbuf; *p && *p != BG_SLASH; - *h++ = *p++) - continue; + eb = &patbuf[patbuf_len - 1]; + for (p = pattern + 1, h = (char *) patbuf; + h < (char*)eb && *p && *p != BG_SLASH; *h++ = *p++) + ; *h = BG_EOS; +#if 0 + if (h == (char *)eb) + return what; +#endif + if (((char *) patbuf)[0] == BG_EOS) { /* * handle a plain ~ or ~/ by expanding $HOME @@ -417,8 +448,7 @@ return pattern; #endif } - } - else { + } else { /* * Expand a ~user */ @@ -433,12 +463,13 @@ } /* Copy the home directory */ - for (b = patbuf; *h; *b++ = *h++) - continue; + for (b = patbuf; b < eb && *h; *b++ = *h++) + ; /* Append the rest of the pattern */ - while ((*b++ = *p++) != BG_EOS) - continue; + while (b < eb && (*b++ = *p++) != BG_EOS) + ; + *b = BG_EOS; return patbuf; } @@ -456,7 +487,8 @@ { const Char *qpat, *qpatnext; int c, err, oldflags, oldpathc; - Char *bufnext, patbuf[MAXPATHLEN+1]; + Char *bufnext, patbuf[MAXPATHLEN]; + size_t limit = 0; #ifdef MACOS_TRADITIONAL if ( (*pattern == BG_TILDE) && (pglob->gl_flags & GLOB_TILDE) ) { @@ -464,7 +496,7 @@ } #endif - qpat = globtilde(pattern, patbuf, pglob); + qpat = globtilde(pattern, patbuf, MAXPATHLEN, pglob); qpatnext = qpat; oldflags = pglob->gl_flags; oldpathc = pglob->gl_pathc; @@ -510,7 +542,7 @@ * to avoid exponential behavior */ if (bufnext == patbuf || bufnext[-1] != M_ALL) - *bufnext++ = M_ALL; + *bufnext++ = M_ALL; break; default: *bufnext++ = CHAR(c); @@ -522,7 +554,7 @@ qprintf("glob0:", patbuf); #endif /* GLOB_DEBUG */ - if ((err = glob1(patbuf, pglob)) != 0) { + if ((err = glob1(patbuf, patbuf+MAXPATHLEN-1, pglob, &limit)) != 0) { pglob->gl_flags = oldflags; return(err); } @@ -542,7 +574,7 @@ printf("calling globextend from glob0\n"); #endif /* GLOB_DEBUG */ pglob->gl_flags = oldflags; - return(globextend(qpat, pglob)); + return(globextend(qpat, pglob, &limit)); } else if (!(pglob->gl_flags & GLOB_NOSORT)) qsort(pglob->gl_pathv + pglob->gl_offs + oldpathc, @@ -556,19 +588,19 @@ static int ci_compare(const void *p, const void *q) { - const char *pp = *(const char **)p; - const char *qq = *(const char **)q; - int ci; - while (*pp && *qq) { - if (tolower(*pp) != tolower(*qq)) - break; - ++pp; - ++qq; - } - ci = tolower(*pp) - tolower(*qq); - if (ci == 0) - return compare(p, q); - return ci; + const char *pp = *(const char **)p; + const char *qq = *(const char **)q; + int ci; + while (*pp && *qq) { + if (tolower(*pp) != tolower(*qq)) + break; + ++pp; + ++qq; + } + ci = tolower(*pp) - tolower(*qq); + if (ci == 0) + return compare(p, q); + return ci; } static int @@ -578,14 +610,16 @@ } static int -glob1(Char *pattern, glob_t *pglob) +glob1(Char *pattern, Char *pattern_last, glob_t *pglob, size_t *limitp) { - Char pathbuf[MAXPATHLEN+1]; + Char pathbuf[MAXPATHLEN]; /* A null pathname is invalid -- POSIX 1003.1 sect. 2.4. */ if (*pattern == BG_EOS) return(0); - return(glob2(pathbuf, pathbuf, pattern, pglob)); + return(glob2(pathbuf, pathbuf+MAXPATHLEN-1, + pathbuf, pathbuf+MAXPATHLEN-1, + pattern, pattern_last, pglob, limitp)); } /* @@ -594,7 +628,8 @@ * meta characters. */ static int -glob2(Char *pathbuf, Char *pathend, Char *pattern, glob_t *pglob) +glob2(Char *pathbuf, Char *pathbuf_last, Char *pathend, Char *pathend_last, + Char *pattern, Char *pattern_last, glob_t *pglob, size_t *limitp) { Stat_t sb; Char *p, *q; @@ -607,7 +642,6 @@ for (anymeta = 0;;) { if (*pattern == BG_EOS) { /* End of pattern? */ *pathend = BG_EOS; - if (g_lstat(pathbuf, &sb, pglob)) return(0); @@ -616,10 +650,12 @@ #ifdef DOSISH && pathend[-1] != BG_SEP2 #endif - ) && (S_ISDIR(sb.st_mode) - || (S_ISLNK(sb.st_mode) && + ) && (S_ISDIR(sb.st_mode) || + (S_ISLNK(sb.st_mode) && (g_stat(pathbuf, &sb, pglob) == 0) && S_ISDIR(sb.st_mode)))) { + if (pathend+1 > pathend_last) + return (1); *pathend++ = BG_SEP; *pathend = BG_EOS; } @@ -627,7 +663,7 @@ #ifdef GLOB_DEBUG printf("calling globextend from glob2\n"); #endif /* GLOB_DEBUG */ - return(globextend(pathbuf, pglob)); + return(globextend(pathbuf, pglob, limitp)); } /* Find end of next segment, copy tentatively to pathend. */ @@ -640,6 +676,8 @@ ) { if (ismeta(*p)) anymeta = 1; + if (q+1 > pathend_last) + return (1); *q++ = *p++; } @@ -650,17 +688,24 @@ #ifdef DOSISH || *pattern == BG_SEP2 #endif - ) + ) { + if (pathend+1 > pathend_last) + return (1); *pathend++ = *pattern++; - } else /* Need expansion, recurse. */ - return(glob3(pathbuf, pathend, pattern, p, pglob)); + } + } else + /* Need expansion, recurse. */ + return(glob3(pathbuf, pathbuf_last, pathend, + pathend_last, pattern, pattern_last, + p, pattern_last, pglob, limitp)); } /* NOTREACHED */ } static int -glob3(Char *pathbuf, Char *pathend, Char *pattern, - Char *restpattern, glob_t *pglob) +glob3(Char *pathbuf, Char *pathbuf_last, Char *pathend, Char *pathend_last, + Char *pattern, Char *pattern_last, + Char *restpattern, Char *restpattern_last, glob_t *pglob, size_t *limitp) { register Direntry_t *dp; DIR *dirp; @@ -676,28 +721,32 @@ */ Direntry_t *(*readdirfunc)(DIR*); + if (pathend > pathend_last) + return (1); *pathend = BG_EOS; errno = 0; #ifdef VMS { - Char *q = pathend; - if (q - pathbuf > 5) { - q -= 5; - if (q[0] == '.' && tolower(q[1]) == 'd' && tolower(q[2]) == 'i' - && tolower(q[3]) == 'r' && q[4] == '/') - { - q[0] = '/'; - q[1] = BG_EOS; - pathend = q+1; - } - } + Char *q = pathend; + if (q - pathbuf > 5) { + q -= 5; + if (q[0] == '.' && + tolower(q[1]) == 'd' && tolower(q[2]) == 'i' && + tolower(q[3]) == 'r' && q[4] == '/') + { + q[0] = '/'; + q[1] = BG_EOS; + pathend = q+1; + } + } } #endif if ((dirp = g_opendir(pathbuf, pglob)) == NULL) { /* TODO: don't call for ENOENT or ENOTDIR? */ if (pglob->gl_errfunc) { - g_Ctoc(pathbuf, buf); + if (g_Ctoc(pathbuf, buf, sizeof(buf))) + return (GLOB_ABEND); if (pglob->gl_errfunc(buf, errno) || (pglob->gl_flags & GLOB_ERR)) return (GLOB_ABEND); @@ -710,7 +759,7 @@ /* Search directory for matching names. */ if (pglob->gl_flags & GLOB_ALTDIRFUNC) - readdirfunc = (Direntry_t *(*)(DIR *))pglob->gl_readdir; + readdirfunc = (Direntry_t *(*)(DIR *))pglob->gl_readdir; else readdirfunc = my_readdir; while ((dp = (*readdirfunc)(dirp))) { @@ -720,14 +769,22 @@ /* Initial BG_DOT must be matched literally. */ if (dp->d_name[0] == BG_DOT && *pattern != BG_DOT) continue; - for (sc = (U8 *) dp->d_name, dc = pathend; - (*dc++ = *sc++) != BG_EOS;) - continue; + dc = pathend; + sc = (U8 *) dp->d_name; + while (dc < pathend_last && (*dc++ = *sc++) != BG_EOS) + ; + if (dc >= pathend_last) { + *dc = BG_EOS; + err = 1; + break; + } + if (!match(pathend, pattern, restpattern, nocase)) { *pathend = BG_EOS; continue; } - err = glob2(pathbuf, --dc, restpattern, pglob); + err = glob2(pathbuf, pathbuf_last, --dc, pathend_last, + restpattern, restpattern_last, pglob, limitp); if (err) break; } @@ -755,10 +812,11 @@ * gl_pathv points to (gl_offs + gl_pathc + 1) items. */ static int -globextend(const Char *path, glob_t *pglob) +globextend(const Char *path, glob_t *pglob, size_t *limitp) { register char **pathv; register int i; + STRLEN newsize, len; char *copy; const Char *p; @@ -769,13 +827,18 @@ printf("\n"); #endif /* GLOB_DEBUG */ + newsize = sizeof(*pathv) * (2 + pglob->gl_pathc + pglob->gl_offs); if (pglob->gl_pathv) - pathv = Renew(pglob->gl_pathv, - (2 + pglob->gl_pathc + pglob->gl_offs),char*); + pathv = Renew(pglob->gl_pathv,newsize,char*); else - New(0,pathv,(2 + pglob->gl_pathc + pglob->gl_offs),char*); - if (pathv == NULL) + New(0,pathv,newsize,char*); + if (pathv == NULL) { + if (pglob->gl_pathv) { + Safefree(pglob->gl_pathv); + pglob->gl_pathv = NULL; + } return(GLOB_NOSPACE); + } if (pglob->gl_pathv == NULL && pglob->gl_offs > 0) { /* first time around -- clear initial gl_offs items */ @@ -786,13 +849,25 @@ pglob->gl_pathv = pathv; for (p = path; *p++;) - continue; + ; + len = (STRLEN)(p - path); + *limitp += len; New(0, copy, p-path, char); if (copy != NULL) { - g_Ctoc(path, copy); + if (g_Ctoc(path, copy, len)) { + Safefree(copy); + return(GLOB_NOSPACE); + } pathv[pglob->gl_offs + pglob->gl_pathc++] = copy; } pathv[pglob->gl_offs + pglob->gl_pathc] = NULL; + + if ((pglob->gl_flags & GLOB_LIMIT) && + newsize + *limitp >= ARG_MAX) { + errno = 0; + return(GLOB_NOSPACE); + } + return(copy == NULL ? GLOB_NOSPACE : 0); } @@ -816,7 +891,8 @@ do if (match(name, pat, patend, nocase)) return(1); - while (*name++ != BG_EOS); + while (*name++ != BG_EOS) + ; return(0); case M_ONE: if (*name++ == BG_EOS) @@ -866,6 +942,7 @@ if (*pp) Safefree(*pp); Safefree(pglob->gl_pathv); + pglob->gl_pathv = NULL; } } @@ -881,13 +958,14 @@ strcpy(buf, "."); #endif } else { - g_Ctoc(str, buf); + if (g_Ctoc(str, buf, sizeof(buf))) + return(NULL); } if (pglob->gl_flags & GLOB_ALTDIRFUNC) return((*pglob->gl_opendir)(buf)); - else - return(PerlDir_open(buf)); + + return(PerlDir_open(buf)); } static int @@ -895,7 +973,8 @@ { char buf[MAXPATHLEN]; - g_Ctoc(fn, buf); + if (g_Ctoc(fn, buf, sizeof(buf))) + return(-1); if (pglob->gl_flags & GLOB_ALTDIRFUNC) return((*pglob->gl_lstat)(buf, sb)); #ifdef HAS_LSTAT @@ -910,7 +989,8 @@ { char buf[MAXPATHLEN]; - g_Ctoc(fn, buf); + if (g_Ctoc(fn, buf, sizeof(buf))) + return(-1); if (pglob->gl_flags & GLOB_ALTDIRFUNC) return((*pglob->gl_stat)(buf, sb)); return(PerlLIO_stat(buf, sb)); @@ -926,29 +1006,14 @@ return (NULL); } -#ifdef notdef -static Char * -g_strcat(Char *dst, const Char *src) -{ - Char *sdst = dst; - - while (*dst++) - continue; - --dst; - while((*dst++ = *src++) != BG_EOS) - continue; - - return (sdst); -} -#endif - -static void -g_Ctoc(register const Char *str, char *buf) +static int +g_Ctoc(register const Char *str, char *buf, STRLEN len) { - register char *dc; - - for (dc = buf; (*dc++ = *str++) != BG_EOS;) - continue; + while (len--) { + if ((*buf++ = *str++) == BG_EOS) + return (0); + } + return (1); } #ifdef GLOB_DEBUG diff -ruN perl-5.6.1/ext/File/Glob/bsd_glob.h AP629_source/ext/File/Glob/bsd_glob.h --- perl-5.6.1/ext/File/Glob/bsd_glob.h Tue Mar 20 09:39:30 2001 +++ AP629_source/ext/File/Glob/bsd_glob.h Thu Aug 23 17:30:22 2001 @@ -30,6 +30,7 @@ * SUCH DAMAGE. * * @(#)glob.h 8.1 (Berkeley) 6/2/93 + * [lots of perl-specific changes since then--see bsd_glob.c] */ #ifndef _BSD_GLOB_H_ @@ -73,6 +74,8 @@ #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_LIMIT 0x4000 /* Limit pattern match output to ARG_MAX + (usually from limits.h). */ #define GLOB_NOSPACE (-1) /* Malloc call failed. */ #define GLOB_ABEND (-2) /* Unignored error. */ diff -ruN perl-5.6.1/ext/POSIX/POSIX.xs AP629_source/ext/POSIX/POSIX.xs --- perl-5.6.1/ext/POSIX/POSIX.xs Thu Apr 5 21:38:46 2001 +++ AP629_source/ext/POSIX/POSIX.xs Thu Aug 23 17:30:22 2001 @@ -333,6 +333,10 @@ init_tm(struct tm *ptm) /* see mktime, strftime and asctime */ { Time_t now; +#if defined(USE_REENTRANT_API) + struct tm tm_result; +# define localtime(x) localtime_r(x, &tm_result) +#endif (void)time(&now); Copy(localtime(&now), ptm, 1, struct tm); } @@ -3755,6 +3759,11 @@ int wday int yday int isdst + PREINIT: +#if defined(USE_REENTRANT_API) + char asctime_buf[26]; +# define asctime(x) asctime_r(x, asctime_buf) +#endif CODE: { struct tm mytm; diff -ruN perl-5.6.1/hints/hpux.sh AP629_source/hints/hpux.sh --- perl-5.6.1/hints/hpux.sh Thu Mar 15 07:25:20 2001 +++ AP629_source/hints/hpux.sh Thu Aug 23 17:30:22 2001 @@ -391,6 +391,7 @@ ;; 11 | 12) # 12 may want upping the _POSIX_C_SOURCE datestamp... ccflags=" -D_POSIX_C_SOURCE=199506L $ccflags" + ccflags="-DUSE_REENTRANT_API $ccflags" set `echo X "$libswanted "| sed -e 's/ c / pthread c /'` shift libswanted="$*" diff -ruN perl-5.6.1/hints/linux.sh AP629_source/hints/linux.sh --- perl-5.6.1/hints/linux.sh Thu Feb 22 18:57:55 2001 +++ AP629_source/hints/linux.sh Thu Aug 23 17:30:23 2001 @@ -269,7 +269,8 @@ cat > UU/usethreads.cbu <<'EOCBU' case "$usethreads" in $define|true|[yY]*) - ccflags="-D_REENTRANT $ccflags" + ccflags="-D_POSIX_C_SOURCE=199506L -D_REENTRANT $ccflags" + ccflags="-DUSE_REENTRANT_API $ccflags" set `echo X "$libswanted "| sed -e 's/ c / pthread c /'` shift libswanted="$*" diff -ruN perl-5.6.1/hints/solaris_2.sh AP629_source/hints/solaris_2.sh --- perl-5.6.1/hints/solaris_2.sh Thu Feb 22 18:57:55 2001 +++ AP629_source/hints/solaris_2.sh Thu Aug 23 17:30:23 2001 @@ -1,5 +1,5 @@ # hints/solaris_2.sh -# Last modified: Tue Jan 2 10:16:35 2001 +# Last modified: Mon Jan 29 12:52:28 2001 # Lupe Christoph # Based on version by: # Andy Dougherty @@ -26,9 +26,16 @@ # these ought to be harmless. See below for more details. # See man vfork. -usevfork=false +usevfork=${usevfork:-false} -d_suidsafe=define +# Solaris has secure SUID scripts +d_suidsafe=${d_suidsafe:-define} + +# Several people reported problems with perl's malloc, especially +# when use64bitall is defined or when using gcc. +# http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2001-01/msg01318.html +# http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2001-01/msg00465.html +usemymalloc=${usemymalloc:-false} # Avoid all libraries in /usr/ucblib. # /lib is just a symlink to /usr/lib @@ -335,7 +342,10 @@ # after it has prompted the user for whether to use threads. case "$usethreads" in $define|true|[yY]*) - ccflags="-D_REENTRANT $ccflags" + # -D_POSIX_C_SOURCE=199506L doesn't compile with gcc 2.95.2 :-( + #ccflags="-D_POSIX_C_SOURCE=199506L -D_REENTRANT $ccflags" + ccflags="-D_POSIX_PTHREAD_SEMANTICS -D_REENTRANT $ccflags" + ccflags="-DUSE_REENTRANT_API $ccflags" # sched_yield is in -lposix4 up to Solaris 2.6, in -lrt starting with Solaris 2.7 case `uname -r` in diff -ruN perl-5.6.1/hints/svr5.sh AP629_source/hints/svr5.sh --- perl-5.6.1/hints/svr5.sh Thu Feb 22 18:57:55 2001 +++ AP629_source/hints/svr5.sh Thu Aug 23 17:30:23 2001 @@ -83,7 +83,7 @@ # remove /shlib and /lib from library search path as both symlink to /usr/lib # where runtime shared libc is -glibpth=`echo " $glibpth " | sed -e 's/ \/shlib / /' -e 's/ \/lib / /` +glibpth=`echo " $glibpth " | sed -e 's/ \/shlib / /' -e 's/ \/lib / /'` # Don't use BSD emulation pieces (/usr/ucblib) regardless # these would probably be autonondetected anyway but ... @@ -156,8 +156,10 @@ # cccdlflags: must tell the compiler to generate relocatable code # lddlflags : must tell the linker to output a shared library -# use shared perl lib -useshrplib='true' +# use shared perl lib if the user doesn't choose otherwise +if test "x$useshrplib" = "x"; then + useshrplib='true' +fi case "$cc" in *gcc*) diff -ruN perl-5.6.1/lib/CGI.pm AP629_source/lib/CGI.pm --- perl-5.6.1/lib/CGI.pm Sat Mar 3 11:53:20 2001 +++ AP629_source/lib/CGI.pm Thu Aug 23 17:30:23 2001 @@ -2350,7 +2350,7 @@ push(@param,'-expires'=>$expires) if $expires; push(@param,'-secure'=>$secure) if $secure; - return new CGI::Cookie(@param); + return CGI::Cookie->new(@param); } END_OF_FUNC diff -ruN perl-5.6.1/lib/Devel/SelfStubber.pm AP629_source/lib/Devel/SelfStubber.pm --- perl-5.6.1/lib/Devel/SelfStubber.pm Thu Feb 22 18:57:55 2001 +++ AP629_source/lib/Devel/SelfStubber.pm Thu Aug 23 17:30:23 2001 @@ -3,7 +3,8 @@ @ISA = qw(SelfLoader); @EXPORT = 'AUTOLOAD'; $JUST_STUBS = 1; -$VERSION = 1.01; sub Version {$VERSION} +$VERSION = '1.02'; +sub Version {$VERSION} # Use as # perl -e 'use Devel::SelfStubber;Devel::SelfStubber->stub(MODULE_NAME,LIB)' diff -ruN perl-5.6.1/lib/ExtUtils/Install.pm AP629_source/lib/ExtUtils/Install.pm --- perl-5.6.1/lib/ExtUtils/Install.pm Thu Feb 22 18:57:55 2001 +++ AP629_source/lib/ExtUtils/Install.pm Thu Aug 23 17:30:23 2001 @@ -120,7 +120,6 @@ return unless -f _; return if $_ eq ".exists"; my $targetdir = MY->catdir($targetroot, $File::Find::dir); - my $origfile = $_; my $targetfile = MY->catfile($targetdir, $_); my $diff = 0; @@ -156,7 +155,7 @@ } else { inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0 } - $packlist->{$origfile}++; + $packlist->{$targetfile}++; }, "."); chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!"); diff -ruN perl-5.6.1/lib/ExtUtils/Installed.pm AP629_source/lib/ExtUtils/Installed.pm --- perl-5.6.1/lib/ExtUtils/Installed.pm Thu Feb 22 18:57:55 2001 +++ AP629_source/lib/ExtUtils/Installed.pm Thu Aug 23 17:30:23 2001 @@ -8,7 +8,28 @@ use Config; use File::Find; use File::Basename; -our $VERSION = '0.02'; +our $VERSION = '0.03'; + +my $DOSISH = ($^O =~ /^(MSWin\d\d|os2|dos|mint)$/); + +sub _is_prefix +{ +my ($self, $path, $prefix) = @_; +if (substr($path, 0, length($prefix)) eq $prefix) + { + return(1); + } +if ($DOSISH) + { + $path =~ s|\\|/|g; + $prefix =~ s|\\|/|g; + if ($path =~ m{^\Q$prefix\E}i) + { + return(1); + } + } +return(0); +} sub _is_type($$$) { @@ -16,22 +37,18 @@ return(1) if ($type eq "all"); if ($type eq "doc") { - return(substr($path, 0, length($Config{installman1dir})) - eq $Config{installman1dir} + return($self->_is_prefix($path, $Config{installman1dir}) || - substr($path, 0, length($Config{installman3dir})) - eq $Config{installman3dir} + $self->_is_prefix($path, $Config{installman3dir}) ? 1 : 0) } if ($type eq "prog") { - return(substr($path, 0, length($Config{prefix})) eq $Config{prefix} + return($self->_is_prefix($path, $Config{prefix}) && - substr($path, 0, length($Config{installman1dir})) - ne $Config{installman1dir} + !$self->_is_prefix($path, $Config{installman1dir}) && - substr($path, 0, length($Config{installman3dir})) - ne $Config{installman3dir} + !$self->_is_prefix($path, $Config{installman3dir}) ? 1 : 0); } return(0); @@ -43,7 +60,7 @@ $under[0] = "" if (! @under); foreach my $dir (@under) { - return(1) if (substr($path, 0, length($dir)) eq $dir); + return(1) if ($self->_is_prefix($path, $dir)); } return(0); } @@ -54,21 +71,32 @@ $class = ref($class) || $class; my $self = {}; +my $installarchlib = $Config{installarchlib}; +my $archlib = $Config{archlib}; +my $sitearch = $Config{sitearch}; + +if ($DOSISH) + { + $installarchlib =~ s|\\|/|g; + $archlib =~ s|\\|/|g; + $sitearch =~ s|\\|/|g; + } + # Read the core packlist $self->{Perl}{packlist} = - ExtUtils::Packlist->new("$Config{installarchlib}/.packlist"); + ExtUtils::Packlist->new("$installarchlib/.packlist"); $self->{Perl}{version} = $Config{version}; # Read the module packlists my $sub = sub { # Only process module .packlists - return if ($_) ne ".packlist" || $File::Find::dir eq $Config{installarchlib}; + return if ($_) ne ".packlist" || $File::Find::dir eq $installarchlib; # Hack of the leading bits of the paths & convert to a module name my $module = $File::Find::name; - $module =~ s!$Config{archlib}/auto/(.*)/.packlist!$1!s; - $module =~ s!$Config{sitearch}/auto/(.*)/.packlist!$1!s; + $module =~ s!\Q$archlib\E/auto/(.*)/.packlist!$1!s; + $module =~ s!\Q$sitearch\E/auto/(.*)/.packlist!$1!s; my $modfile = "$module.pm"; $module =~ s!/!::!g; @@ -87,7 +115,7 @@ # Read the .packlist $self->{$module}{packlist} = ExtUtils::Packlist->new($File::Find::name); }; -find($sub, $Config{archlib}, $Config{sitearch}); +find($sub, $archlib, $sitearch); return(bless($self, $class)); } diff -ruN perl-5.6.1/lib/locale.pm AP629_source/lib/locale.pm --- perl-5.6.1/lib/locale.pm Thu Feb 22 18:57:55 2001 +++ AP629_source/lib/locale.pm Thu Aug 23 17:30:24 2001 @@ -25,7 +25,7 @@ =cut -$locale::hint_bits = 0x800; +$locale::hint_bits = 0x4; sub import { $^H |= $locale::hint_bits; diff -ruN perl-5.6.1/makedef.pl AP629_source/makedef.pl --- perl-5.6.1/makedef.pl Mon Mar 19 00:49:53 2001 +++ AP629_source/makedef.pl Thu Aug 23 17:30:25 2001 @@ -398,10 +398,6 @@ emit_symbols [qw( Perl_dump_mstats Perl_get_mstats - Perl_malloc - Perl_mfree - Perl_realloc - Perl_calloc Perl_strdup Perl_putenv )]; @@ -421,10 +417,6 @@ PL_malloc_mutex Perl_dump_mstats Perl_get_mstats - Perl_malloc - Perl_mfree - Perl_realloc - Perl_calloc Perl_malloced_size )]; } diff -ruN perl-5.6.1/mg.c AP629_source/mg.c --- perl-5.6.1/mg.c Wed Mar 21 21:05:02 2001 +++ AP629_source/mg.c Thu Aug 23 17:30:25 2001 @@ -562,6 +562,8 @@ (void)SvOK_off(sv); else if (PL_in_eval) sv_setiv(sv, PL_in_eval & ~(EVAL_INREQUIRE)); + else + sv_setiv(sv, 0); } break; case '\024': /* ^T */ @@ -661,7 +663,7 @@ case '.': #ifndef lint if (GvIO(PL_last_in_gv)) { - sv_setiv(sv, (IV)IoLINES(GvIO(PL_last_in_gv))); + sv_setiv(sv, (IV)IoLINES(GvIOp(PL_last_in_gv))); } #endif break; diff -ruN perl-5.6.1/op.c AP629_source/op.c --- perl-5.6.1/op.c Sat Apr 7 23:09:16 2001 +++ AP629_source/op.c Thu Aug 23 17:30:25 2001 @@ -372,15 +372,24 @@ switch (CxTYPE(cx)) { default: if (i == 0 && saweval) { - seq = cxstack[saweval].blk_oldcop->cop_seq; return pad_findlex(name, newoff, seq, PL_main_cv, -1, saweval, 0); } break; case CXt_EVAL: switch (cx->blk_eval.old_op_type) { case OP_ENTEREVAL: - if (CxREALEVAL(cx)) + if (CxREALEVAL(cx)) { + PADOFFSET off; saweval = i; + seq = cxstack[i].blk_oldcop->cop_seq; + startcv = cxstack[i].blk_eval.cv; + if (startcv && CvOUTSIDE(startcv)) { + off = pad_findlex(name, newoff, seq, CvOUTSIDE(startcv), + i-1, saweval, 0); + if (off) /* continue looking if not found here */ + return off; + } + } break; case OP_DOFILE: case OP_REQUIRE: @@ -395,9 +404,9 @@ cv = cx->blk_sub.cv; if (PL_debstash && CvSTASH(cv) == PL_debstash) { /* ignore DB'* scope */ saweval = i; /* so we know where we were called from */ + seq = cxstack[i].blk_oldcop->cop_seq; continue; } - seq = cxstack[saweval].blk_oldcop->cop_seq; return pad_findlex(name, newoff, seq, cv, i-1, saweval,FINDLEX_NOSEARCH); } } @@ -1352,31 +1361,6 @@ PL_modcount++; return o; case OP_CONST: - if (o->op_private & (OPpCONST_BARE) && - !(type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)) { - SV *sv = ((SVOP*)o)->op_sv; - GV *gv; - - /* Could be a filehandle */ - if (gv = gv_fetchpv(SvPV_nolen(sv), FALSE, SVt_PVIO)) { - OP* gvio = newUNOP(OP_RV2GV, 0, newGVOP(OP_GV, 0, gv)); - op_free(o); - o = gvio; - } else { - /* OK, it's a sub */ - OP* enter; - gv = gv_fetchpv(SvPV_nolen(sv), TRUE, SVt_PVCV); - - enter = newUNOP(OP_ENTERSUB,0, - newUNOP(OP_RV2CV, 0, - newGVOP(OP_GV, 0, gv) - )); - enter->op_private |= OPpLVAL_INTRO; - op_free(o); - o = enter; - } - break; - } if (!(o->op_private & (OPpCONST_ARYBASE))) goto nomod; if (PL_eval_start && PL_eval_start->op_type == OP_CONST) { @@ -2269,8 +2253,8 @@ case OP_SLE: case OP_SGE: case OP_SCMP: - - if (o->op_private & OPpLOCALE) + /* XXX what about the numeric ops? */ + if (PL_hints & HINT_LOCALE) goto nope; } @@ -3158,7 +3142,6 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg) { OP *pack; - OP *rqop; OP *imop; OP *veop; GV *gv; @@ -3219,22 +3202,6 @@ newSVOP(OP_METHOD_NAMED, 0, meth))); } - /* Fake up a require, handle override, if any */ - gv = gv_fetchpv("require", FALSE, SVt_PVCV); - if (!(gv && GvIMPORTED_CV(gv))) - gv = gv_fetchpv("CORE::GLOBAL::require", FALSE, SVt_PVCV); - - if (gv && GvIMPORTED_CV(gv)) { - rqop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED, - append_elem(OP_LIST, id, - scalar(newUNOP(OP_RV2CV, 0, - newGVOP(OP_GV, 0, - gv)))))); - } - else { - rqop = newUNOP(OP_REQUIRE, 0, id); - } - /* Fake up the BEGIN {}, which does its thing immediately. */ newATTRSUB(floor, newSVOP(OP_CONST, 0, newSVpvn("BEGIN", 5)), @@ -3242,7 +3209,7 @@ Nullop, append_elem(OP_LINESEQ, append_elem(OP_LINESEQ, - newSTATEOP(0, Nullch, rqop), + newSTATEOP(0, Nullch, newUNOP(OP_REQUIRE, 0, id)), newSTATEOP(0, Nullch, veop)), newSTATEOP(0, Nullch, imop) )); @@ -3546,7 +3513,7 @@ cop->op_ppaddr = PL_ppaddr[ OP_NEXTSTATE ]; } cop->op_flags = flags; - cop->op_private = (PL_hints & HINT_BYTE); + cop->op_private = (PL_hints & (HINT_BYTE|HINT_LOCALE)); #ifdef NATIVE_HINTS cop->op_private |= NATIVE_HINTS; #endif @@ -4135,9 +4102,15 @@ * CV, they don't hold a refcount on the outside CV. This avoids * the refcount loop between the outer CV (which keeps a refcount to * the closure prototype in the pad entry for pp_anoncode()) and the - * closure prototype, and the ensuing memory leak. --GSAR */ - if (!CvANON(cv) || CvCLONED(cv)) + * closure prototype, and the ensuing memory leak. This does not + * apply to closures generated within eval"", since eval"" CVs are + * ephemeral. --GSAR */ + if (!CvANON(cv) || CvCLONED(cv) + || (CvOUTSIDE(cv) && SvTYPE(CvOUTSIDE(cv)) == SVt_PVCV + && CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv)))) + { SvREFCNT_dec(CvOUTSIDE(cv)); + } CvOUTSIDE(cv) = Nullcv; if (CvPADLIST(cv)) { /* may be during global destruction */ @@ -4694,12 +4667,17 @@ } } - /* If a potential closure prototype, don't keep a refcount on outer CV. + /* If a potential closure prototype, don't keep a refcount on + * outer CV, unless the latter happens to be a passing eval"". * This is okay as the lifetime of the prototype is tied to the * lifetime of the outer CV. Avoids memory leak due to reference * loop. --GSAR */ - if (!name) + if (!name && CvOUTSIDE(cv) + && !(SvTYPE(CvOUTSIDE(cv)) == SVt_PVCV + && CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv)))) + { SvREFCNT_dec(CvOUTSIDE(cv)); + } if (name || aname) { char *s; @@ -5471,13 +5449,6 @@ else o = newUNOP(type, 0, newDEFSVOP()); } -#ifdef USE_LOCALE - if (type == OP_FTTEXT || type == OP_FTBINARY) { - o->op_private = 0; - if (PL_hints & HINT_LOCALE) - o->op_private |= OPpLOCALE; - } -#endif return o; } @@ -5878,29 +5849,7 @@ if (!kid) append_elem(o->op_type, o, newDEFSVOP()); - o = listkids(o); - - o->op_private = 0; -#ifdef USE_LOCALE - if (PL_hints & HINT_LOCALE) - o->op_private |= OPpLOCALE; -#endif - - return o; -} - -OP * -Perl_ck_fun_locale(pTHX_ OP *o) -{ - o = ck_fun(o); - - o->op_private = 0; -#ifdef USE_LOCALE - if (PL_hints & HINT_LOCALE) - o->op_private |= OPpLOCALE; -#endif - - return o; + return listkids(o); } OP * @@ -5934,18 +5883,6 @@ } OP * -Perl_ck_scmp(pTHX_ OP *o) -{ - o->op_private = 0; -#ifdef USE_LOCALE - if (PL_hints & HINT_LOCALE) - o->op_private |= OPpLOCALE; -#endif - - return o; -} - -OP * Perl_ck_match(pTHX_ OP *o) { o->op_private |= OPpRUNTIME; @@ -6023,6 +5960,8 @@ OP * Perl_ck_require(pTHX_ OP *o) { + GV* gv; + if (o->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */ SVOP *kid = (SVOP*)cUNOPo->op_first; @@ -6044,6 +5983,23 @@ sv_catpvn(kid->op_sv, ".pm", 3); } } + + /* handle override, if any */ + gv = gv_fetchpv("require", FALSE, SVt_PVCV); + if (!(gv && GvIMPORTED_CV(gv))) + gv = gv_fetchpv("CORE::GLOBAL::require", FALSE, SVt_PVCV); + + if (gv && GvIMPORTED_CV(gv)) { + OP *kid = cUNOPo->op_first; + cUNOPo->op_first = 0; + op_free(o); + return ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, kid, + scalar(newUNOP(OP_RV2CV, 0, + newGVOP(OP_GV, 0, + gv)))))); + } + return ck_fun(o); } @@ -6121,11 +6077,6 @@ Perl_ck_sort(pTHX_ OP *o) { OP *firstkid; - o->op_private = 0; -#ifdef USE_LOCALE - if (PL_hints & HINT_LOCALE) - o->op_private |= OPpLOCALE; -#endif if (o->op_type == OP_SORT && o->op_flags & OPf_STACKED) simplify_sort(o); diff -ruN perl-5.6.1/op.h AP629_source/op.h --- perl-5.6.1/op.h Wed Mar 21 21:05:02 2001 +++ AP629_source/op.h Thu Aug 23 17:30:25 2001 @@ -184,10 +184,6 @@ /* Private for OP_EXISTS */ #define OPpEXISTS_SUB 64 /* Checking for &sub, not {} or []. */ -/* Private for OP_SORT, OP_PRTF, OP_SPRINTF, OP_FTTEXT, OP_FTBINARY, */ -/* string comparisons, and case changers. */ -#define OPpLOCALE 64 /* Use locale */ - /* Private for OP_SORT */ #define OPpSORT_NUMERIC 1 /* Optimized away { $a <=> $b } */ #define OPpSORT_INTEGER 2 /* Ditto while under "use integer" */ diff -ruN perl-5.6.1/opcode.h AP629_source/opcode.h --- perl-5.6.1/opcode.h Thu Feb 22 18:57:56 2001 +++ AP629_source/opcode.h Thu Aug 23 17:30:25 2001 @@ -1178,13 +1178,13 @@ MEMBER_TO_FPTR(Perl_ck_null), /* i_ne */ MEMBER_TO_FPTR(Perl_ck_null), /* ncmp */ MEMBER_TO_FPTR(Perl_ck_null), /* i_ncmp */ - MEMBER_TO_FPTR(Perl_ck_scmp), /* slt */ - MEMBER_TO_FPTR(Perl_ck_scmp), /* sgt */ - MEMBER_TO_FPTR(Perl_ck_scmp), /* sle */ - MEMBER_TO_FPTR(Perl_ck_scmp), /* sge */ + MEMBER_TO_FPTR(Perl_ck_null), /* slt */ + MEMBER_TO_FPTR(Perl_ck_null), /* sgt */ + MEMBER_TO_FPTR(Perl_ck_null), /* sle */ + MEMBER_TO_FPTR(Perl_ck_null), /* sge */ MEMBER_TO_FPTR(Perl_ck_null), /* seq */ MEMBER_TO_FPTR(Perl_ck_null), /* sne */ - MEMBER_TO_FPTR(Perl_ck_scmp), /* scmp */ + MEMBER_TO_FPTR(Perl_ck_null), /* scmp */ MEMBER_TO_FPTR(Perl_ck_bitop), /* bit_and */ MEMBER_TO_FPTR(Perl_ck_bitop), /* bit_xor */ MEMBER_TO_FPTR(Perl_ck_bitop), /* bit_or */ @@ -1209,15 +1209,15 @@ MEMBER_TO_FPTR(Perl_ck_fun), /* vec */ MEMBER_TO_FPTR(Perl_ck_index), /* index */ MEMBER_TO_FPTR(Perl_ck_index), /* rindex */ - MEMBER_TO_FPTR(Perl_ck_fun_locale), /* sprintf */ + MEMBER_TO_FPTR(Perl_ck_fun), /* sprintf */ MEMBER_TO_FPTR(Perl_ck_fun), /* formline */ MEMBER_TO_FPTR(Perl_ck_fun), /* ord */ MEMBER_TO_FPTR(Perl_ck_fun), /* chr */ MEMBER_TO_FPTR(Perl_ck_fun), /* crypt */ - MEMBER_TO_FPTR(Perl_ck_fun_locale), /* ucfirst */ - MEMBER_TO_FPTR(Perl_ck_fun_locale), /* lcfirst */ - MEMBER_TO_FPTR(Perl_ck_fun_locale), /* uc */ - MEMBER_TO_FPTR(Perl_ck_fun_locale), /* lc */ + MEMBER_TO_FPTR(Perl_ck_fun), /* ucfirst */ + MEMBER_TO_FPTR(Perl_ck_fun), /* lcfirst */ + MEMBER_TO_FPTR(Perl_ck_fun), /* uc */ + MEMBER_TO_FPTR(Perl_ck_fun), /* lc */ MEMBER_TO_FPTR(Perl_ck_fun), /* quotemeta */ MEMBER_TO_FPTR(Perl_ck_rvconst), /* rv2av */ MEMBER_TO_FPTR(Perl_ck_null), /* aelemfast */ diff -ruN perl-5.6.1/opcode.pl AP629_source/opcode.pl --- perl-5.6.1/opcode.pl Sat Mar 3 11:53:20 2001 +++ AP629_source/opcode.pl Thu Aug 23 17:30:25 2001 @@ -478,13 +478,13 @@ ncmp numeric comparison (<=>) ck_null Iifst2 S S i_ncmp integer comparison (<=>) ck_null ifst2 S S -slt string lt ck_scmp ifs2 S S -sgt string gt ck_scmp ifs2 S S -sle string le ck_scmp ifs2 S S -sge string ge ck_scmp ifs2 S S +slt string lt ck_null ifs2 S S +sgt string gt ck_null ifs2 S S +sle string le ck_null ifs2 S S +sge string ge ck_null ifs2 S S seq string eq ck_null ifs2 S S sne string ne ck_null ifs2 S S -scmp string comparison (cmp) ck_scmp ifst2 S S +scmp string comparison (cmp) ck_null ifst2 S S bit_and bitwise and (&) ck_bitop fst2 S S bit_xor bitwise xor (^) ck_bitop fst2 S S @@ -522,15 +522,15 @@ index index ck_index isT@ S S S? rindex rindex ck_index isT@ S S S? -sprintf sprintf ck_fun_locale mfst@ S L +sprintf sprintf ck_fun mfst@ S L formline formline ck_fun ms@ S L ord ord ck_fun ifsTu% S? chr chr ck_fun fsTu% S? crypt crypt ck_fun fsT@ S S -ucfirst ucfirst ck_fun_locale fstu% S? -lcfirst lcfirst ck_fun_locale fstu% S? -uc uc ck_fun_locale fstu% S? -lc lc ck_fun_locale fstu% S? +ucfirst ucfirst ck_fun fstu% S? +lcfirst lcfirst ck_fun fstu% S? +uc uc ck_fun fstu% S? +lc lc ck_fun fstu% S? quotemeta quotemeta ck_fun fstu% S? # Arrays. diff -ruN perl-5.6.1/patchlevel.h AP629_source/patchlevel.h --- perl-5.6.1/patchlevel.h Sun Apr 8 18:14:57 2001 +++ AP629_source/patchlevel.h Thu Aug 23 17:30:25 2001 @@ -1,5 +1,7 @@ #ifndef __PATCHLEVEL_H_INCLUDED__ +#include "BuildInfo.h" + /* do not adjust the whitespace! Configure expects the numbers to be * exactly on the third column */ @@ -70,6 +72,7 @@ #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT) static char *local_patches[] = { NULL + ,ACTIVEPERL_LOCAL_PATCHES_ENTRY ,NULL }; diff -ruN perl-5.6.1/perl.c AP629_source/perl.c --- perl-5.6.1/perl.c Wed Mar 21 21:05:02 2001 +++ AP629_source/perl.c Thu Aug 23 17:30:25 2001 @@ -58,6 +58,32 @@ } STMT_END #else # if defined(USE_ITHREADS) + +static void S_atfork_lock(void); +static void S_atfork_unlock(void); + +/* this is called in parent before the fork() */ +static void +S_atfork_lock(void) +{ + /* locks must be held in locking order (if any) */ +#ifdef MYMALLOC + MUTEX_LOCK(&PL_malloc_mutex); +#endif + OP_REFCNT_LOCK; +} + +/* this is called in both parent and child after the fork() */ +static void +S_atfork_unlock(void) +{ + /* locks must be released in same order as in S_atfork_lock() */ +#ifdef MYMALLOC + MUTEX_UNLOCK(&PL_malloc_mutex); +#endif + OP_REFCNT_UNLOCK; +} + # define INIT_TLS_AND_INTERP \ STMT_START { \ if (!PL_curinterp) { \ @@ -66,6 +92,9 @@ ALLOC_THREAD_KEY; \ PERL_SET_THX(my_perl); \ OP_REFCNT_INIT; \ + PTHREAD_ATFORK(S_atfork_lock, \ + S_atfork_unlock, \ + S_atfork_unlock); \ } \ else { \ PERL_SET_THX(my_perl); \ @@ -1170,11 +1199,13 @@ #endif (s = PerlEnv_getenv("PERL5OPT"))) { + char *popt = s; while (isSPACE(*s)) s++; if (*s == '-' && *(s+1) == 'T') PL_tainting = TRUE; else { + char *popt_copy = Nullch; while (s && *s) { char *d; while (isSPACE(*s)) @@ -1191,6 +1222,11 @@ Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s); while (++s && *s) { if (isSPACE(*s)) { + if (!popt_copy) { + popt_copy = SvPVX(sv_2mortal(newSVpv(popt,0))); + s = popt_copy + (s - popt); + d = popt_copy + (d - popt); + } *s++ = '\0'; break; } diff -ruN perl-5.6.1/perl.h AP629_source/perl.h --- perl-5.6.1/perl.h Wed Mar 21 21:05:02 2001 +++ AP629_source/perl.h Thu Aug 23 17:30:25 2001 @@ -254,6 +254,15 @@ # define dTHXx dTHX #endif +/* Under PERL_IMPLICIT_SYS (used in Windows for fork emulation) + * PerlIO_foo() expands to PL_StdIO->pFOO(PL_StdIO, ...). + * dTHXs is therefore needed for all functions using PerlIO_foo(). */ +#ifdef PERL_IMPLICIT_SYS +# define dTHXs dTHX +#else +# define dTHXs dNOOP +#endif + #undef START_EXTERN_C #undef END_EXTERN_C #undef EXTERN_C @@ -2667,7 +2676,7 @@ #define HINT_PRIVATE_MASK 0x000000ff #define HINT_INTEGER 0x00000001 #define HINT_STRICT_REFS 0x00000002 -/* #define HINT_notused4 0x00000004 */ +#define HINT_LOCALE 0x00000004 #define HINT_BYTE 0x00000008 /* #define HINT_notused10 0x00000010 */ /* Note: 20,40,80 used for NATIVE_HINTS */ @@ -2675,7 +2684,6 @@ #define HINT_BLOCK_SCOPE 0x00000100 #define HINT_STRICT_SUBS 0x00000200 #define HINT_STRICT_VARS 0x00000400 -#define HINT_LOCALE 0x00000800 #define HINT_NEW_INTEGER 0x00001000 #define HINT_NEW_FLOAT 0x00002000 @@ -3187,16 +3195,24 @@ #define SET_NUMERIC_LOCAL() \ set_numeric_local(); -#define IS_NUMERIC_RADIX(s) \ - ((PL_hints & HINT_LOCALE) && \ - PL_numeric_radix_sv && memEQ(s, SvPVX(PL_numeric_radix_sv), SvCUR(PL_numeric_radix_sv))) +#define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE) +#define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE) + +#define IN_LOCALE \ + (PL_curcop == &PL_compiling ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) + +#define IS_NUMERIC_RADIX(s, send) \ + (PL_numeric_radix_sv \ + && IN_LOCALE \ + && SvCUR(PL_numeric_radix_sv) <= ((send)-(s)) \ + && memEQ(s, SvPVX(PL_numeric_radix_sv), SvCUR(PL_numeric_radix_sv))) #define STORE_NUMERIC_LOCAL_SET_STANDARD() \ - bool was_local = (PL_hints & HINT_LOCALE) && PL_numeric_local; \ + bool was_local = PL_numeric_local && IN_LOCALE; \ if (was_local) SET_NUMERIC_STANDARD(); #define STORE_NUMERIC_STANDARD_SET_LOCAL() \ - bool was_standard = (PL_hints & HINT_LOCALE) && PL_numeric_standard; \ + bool was_standard = PL_numeric_standard && IN_LOCALE; \ if (was_standard) SET_NUMERIC_LOCAL(); #define RESTORE_NUMERIC_LOCAL() \ @@ -3211,7 +3227,7 @@ #define SET_NUMERIC_STANDARD() /**/ #define SET_NUMERIC_LOCAL() /**/ -#define IS_NUMERIC_RADIX(c) (0) +#define IS_NUMERIC_RADIX(a, b) (0) #define STORE_NUMERIC_LOCAL_SET_STANDARD() /**/ #define STORE_NUMERIC_STANDARD_SET_LOCAL() /**/ #define RESTORE_NUMERIC_LOCAL() /**/ diff -ruN perl-5.6.1/perly.c AP629_source/perly.c --- perl-5.6.1/perly.c Sun Mar 18 02:50:04 2001 +++ AP629_source/perly.c Thu Aug 23 17:30:25 2001 @@ -1568,12 +1568,12 @@ #if defined(YYDEBUG) && defined(DEBUGGING) yydebug = (PL_debug & 1); #endif - PL_expect = XSTATE; + PL_expect = XSTATE; yyval.ival = block_start(TRUE); } break; case 2: #line 132 "perly.y" -{ newPROG(yyvsp[0].opval); } +{ newPROG(block_end(yyvsp[-1].ival,yyvsp[0].opval)); } break; case 3: #line 136 "perly.y" diff -ruN perl-5.6.1/perly.y AP629_source/perly.y --- perl-5.6.1/perly.y Fri Mar 23 07:41:18 2001 +++ AP629_source/perly.y Thu Aug 23 17:30:25 2001 @@ -127,10 +127,10 @@ #if defined(YYDEBUG) && defined(DEBUGGING) yydebug = (PL_debug & 1); #endif - PL_expect = XSTATE; + PL_expect = XSTATE; $$ = block_start(TRUE); } /*CONTINUED*/ lineseq - { newPROG($2); } + { newPROG(block_end($1,$2)); } ; block : '{' remember lineseq '}' diff -ruN perl-5.6.1/pp.c AP629_source/pp.c --- perl-5.6.1/pp.c Sat Apr 7 23:09:16 2001 +++ AP629_source/pp.c Thu Aug 23 17:30:26 2001 @@ -528,7 +528,7 @@ SvTEMP_off(sv); (void)SvREFCNT_inc(sv); } - else if (SvPADTMP(sv)) + else if (SvPADTMP(sv) && !IS_PADGV(sv)) sv = newSVsv(sv); else { SvTEMP_off(sv); @@ -1209,6 +1209,12 @@ PP(pp_ne) { dSP; tryAMAGICbinSET(ne,0); +#ifndef NV_PRESERVES_UV + if (SvROK(TOPs) && SvROK(TOPm1s)) { + SETs(boolSV(SvRV(TOPs) != SvRV(TOPm1s))); + RETURN; + } +#endif { dPOPnv; SETs(boolSV(TOPn != value)); @@ -1219,6 +1225,12 @@ PP(pp_ncmp) { dSP; dTARGET; tryAMAGICbin(ncmp,0); +#ifndef NV_PRESERVES_UV + if (SvROK(TOPs) && SvROK(TOPm1s)) { + SETi(PTR2UV(SvRV(TOPs)) - PTR2UV(SvRV(TOPm1s))); + RETURN; + } +#endif { dPOPTOPnnrl; I32 value; @@ -1251,7 +1263,7 @@ dSP; tryAMAGICbinSET(slt,0); { dPOPTOPssrl; - int cmp = ((PL_op->op_private & OPpLOCALE) + int cmp = (IN_LOCALE_RUNTIME ? sv_cmp_locale(left, right) : sv_cmp(left, right)); SETs(boolSV(cmp < 0)); @@ -1264,7 +1276,7 @@ dSP; tryAMAGICbinSET(sgt,0); { dPOPTOPssrl; - int cmp = ((PL_op->op_private & OPpLOCALE) + int cmp = (IN_LOCALE_RUNTIME ? sv_cmp_locale(left, right) : sv_cmp(left, right)); SETs(boolSV(cmp > 0)); @@ -1277,7 +1289,7 @@ dSP; tryAMAGICbinSET(sle,0); { dPOPTOPssrl; - int cmp = ((PL_op->op_private & OPpLOCALE) + int cmp = (IN_LOCALE_RUNTIME ? sv_cmp_locale(left, right) : sv_cmp(left, right)); SETs(boolSV(cmp <= 0)); @@ -1290,7 +1302,7 @@ dSP; tryAMAGICbinSET(sge,0); { dPOPTOPssrl; - int cmp = ((PL_op->op_private & OPpLOCALE) + int cmp = (IN_LOCALE_RUNTIME ? sv_cmp_locale(left, right) : sv_cmp(left, right)); SETs(boolSV(cmp >= 0)); @@ -1323,7 +1335,7 @@ dSP; dTARGET; tryAMAGICbin(scmp,0); { dPOPTOPssrl; - int cmp = ((PL_op->op_private & OPpLOCALE) + int cmp = (IN_LOCALE_RUNTIME ? sv_cmp_locale(left, right) : sv_cmp(left, right)); SETi( cmp ); @@ -2354,7 +2366,7 @@ U8 *tend; UV uv = utf8_to_uv(s, slen, &ulen, 0); - if (PL_op->op_private & OPpLOCALE) { + if (IN_LOCALE_RUNTIME) { TAINT; SvTAINTED_on(sv); uv = toTITLE_LC_uni(uv); @@ -2386,7 +2398,7 @@ } s = (U8*)SvPV_force(sv, slen); if (*s) { - if (PL_op->op_private & OPpLOCALE) { + if (IN_LOCALE_RUNTIME) { TAINT; SvTAINTED_on(sv); *s = toUPPER_LC(*s); @@ -2413,7 +2425,7 @@ U8 *tend; UV uv = utf8_to_uv(s, slen, &ulen, 0); - if (PL_op->op_private & OPpLOCALE) { + if (IN_LOCALE_RUNTIME) { TAINT; SvTAINTED_on(sv); uv = toLOWER_LC_uni(uv); @@ -2445,7 +2457,7 @@ } s = (U8*)SvPV_force(sv, slen); if (*s) { - if (PL_op->op_private & OPpLOCALE) { + if (IN_LOCALE_RUNTIME) { TAINT; SvTAINTED_on(sv); *s = toLOWER_LC(*s); @@ -2484,7 +2496,7 @@ (void)SvPOK_only(TARG); d = (U8*)SvPVX(TARG); send = s + len; - if (PL_op->op_private & OPpLOCALE) { + if (IN_LOCALE_RUNTIME) { TAINT; SvTAINTED_on(TARG); while (s < send) { @@ -2516,7 +2528,7 @@ if (len) { register U8 *send = s + len; - if (PL_op->op_private & OPpLOCALE) { + if (IN_LOCALE_RUNTIME) { TAINT; SvTAINTED_on(sv); for (; s < send; s++) @@ -2558,7 +2570,7 @@ (void)SvPOK_only(TARG); d = (U8*)SvPVX(TARG); send = s + len; - if (PL_op->op_private & OPpLOCALE) { + if (IN_LOCALE_RUNTIME) { TAINT; SvTAINTED_on(TARG); while (s < send) { @@ -2591,7 +2603,7 @@ if (len) { register U8 *send = s + len; - if (PL_op->op_private & OPpLOCALE) { + if (IN_LOCALE_RUNTIME) { TAINT; SvTAINTED_on(sv); for (; s < send; s++) diff -ruN perl-5.6.1/pp.h AP629_source/pp.h --- perl-5.6.1/pp.h Wed Mar 21 21:05:02 2001 +++ AP629_source/pp.h Thu Aug 23 17:30:26 2001 @@ -127,6 +127,8 @@ #endif #define TOPs (*sp) +#define TOPm1s (*(sp-1)) +#define TOPp1s (*(sp+1)) #define TOPp (SvPV(TOPs, PL_na)) /* deprecated */ #define TOPpx (SvPV(TOPs, n_a)) #define TOPn (SvNV(TOPs)) diff -ruN perl-5.6.1/pp.sym AP629_source/pp.sym --- perl-5.6.1/pp.sym Thu Feb 22 18:57:57 2001 +++ AP629_source/pp.sym Thu Aug 23 17:30:26 2001 @@ -16,7 +16,6 @@ Perl_ck_exit Perl_ck_ftst Perl_ck_fun -Perl_ck_fun_locale Perl_ck_glob Perl_ck_grep Perl_ck_index @@ -34,7 +33,6 @@ Perl_ck_rfun Perl_ck_rvconst Perl_ck_sassign -Perl_ck_scmp Perl_ck_select Perl_ck_shift Perl_ck_sort diff -ruN perl-5.6.1/pp_ctl.c AP629_source/pp_ctl.c --- perl-5.6.1/pp_ctl.c Thu Apr 5 21:38:46 2001 +++ AP629_source/pp_ctl.c Thu Aug 23 17:30:27 2001 @@ -135,6 +135,8 @@ pm = PL_curpm; else if (strEQ("\\s+", pm->op_pmregexp->precomp)) pm->op_pmflags |= PMf_WHITE; + else + pm->op_pmflags &= ~PMf_WHITE; /* XXX runtime compiled output needs to move to the pad */ if (pm->op_pmflags & PMf_KEEP) { @@ -981,7 +983,7 @@ ? ( (PL_op->op_private & OPpSORT_INTEGER) ? ( overloading ? amagic_i_ncmp : sv_i_ncmp) : ( overloading ? amagic_ncmp : sv_ncmp)) - : ( (PL_op->op_private & OPpLOCALE) + : ( IN_LOCALE_RUNTIME ? ( overloading ? amagic_cmp_locale : sv_cmp_locale_static) @@ -1029,7 +1031,7 @@ if (PL_op->op_private & OPpFLIP_LINENUM) { struct io *gp_io; flip = PL_last_in_gv - && (gp_io = GvIOp(PL_last_in_gv)) + && (gp_io = GvIO(PL_last_in_gv)) && SvIV(sv) == (IV)IoLINES(gp_io); } else { flip = SvTRUE(sv); @@ -1110,7 +1112,8 @@ SV *targ = PAD_SV(cUNOP->op_first->op_targ); sv_inc(targ); if ((PL_op->op_private & OPpFLIP_LINENUM) - ? (PL_last_in_gv && SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv))) + ? (GvIO(PL_last_in_gv) + && SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv))) : SvTRUE(sv) ) { sv_setiv(PAD_SV(((UNOP*)cUNOP->op_first)->op_first->op_targ), 0); sv_catpv(targ, "E0"); @@ -2759,6 +2762,9 @@ PL_compcv = (CV*)NEWSV(1104,0); sv_upgrade((SV *)PL_compcv, SVt_PVCV); CvEVAL_on(PL_compcv); + assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL); + cxstack[cxstack_ix].blk_eval.cv = PL_compcv; + #ifdef USE_THREADS CvOWNER(PL_compcv) = 0; New(666, CvMUTEXP(PL_compcv), 1, perl_mutex); @@ -2956,7 +2962,7 @@ sv = POPs; if (SvNIOKp(sv)) { - if (SvPOK(sv) && SvNOK(sv)) { /* require v5.6.1 */ + if (SvPOK(sv) && SvNOK(sv) && SvNV(sv)) { /* require v5.6.1 */ UV rev = 0, ver = 0, sver = 0; STRLEN len; U8 *s = (U8*)SvPVX(sv); diff -ruN perl-5.6.1/pp_hot.c AP629_source/pp_hot.c --- perl-5.6.1/pp_hot.c Wed Mar 21 21:05:02 2001 +++ AP629_source/pp_hot.c Thu Aug 23 17:30:27 2001 @@ -230,6 +230,12 @@ PP(pp_eq) { dSP; tryAMAGICbinSET(eq,0); +#ifndef NV_PRESERVES_UV + if (SvROK(TOPs) && SvROK(TOPm1s)) { + SETs(boolSV(SvRV(TOPs) == SvRV(TOPm1s))); + RETURN; + } +#endif { dPOPnv; SETs(boolSV(TOPn == value)); @@ -1731,13 +1737,21 @@ SvREFCNT_dec(*itersvp); - if ((sv = SvMAGICAL(av) - ? *av_fetch(av, ++cx->blk_loop.iterix, FALSE) - : AvARRAY(av)[++cx->blk_loop.iterix])) + if (SvMAGICAL(av) || AvREIFY(av)) { + SV **svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE); + if (svp) + sv = *svp; + else + sv = Nullsv; + } + else { + sv = AvARRAY(av)[++cx->blk_loop.iterix]; + } + if (sv) SvTEMP_off(sv); else sv = &PL_sv_undef; - if (av != PL_curstack && SvIMMORTAL(sv)) { + if (av != PL_curstack && sv == &PL_sv_undef) { SV *lv = cx->blk_loop.iterlval; if (lv && SvREFCNT(lv) > 1) { SvREFCNT_dec(lv); diff -ruN perl-5.6.1/pp_proto.h AP629_source/pp_proto.h --- perl-5.6.1/pp_proto.h Thu Feb 22 18:57:57 2001 +++ AP629_source/pp_proto.h Thu Aug 23 17:30:27 2001 @@ -15,7 +15,6 @@ PERL_CKDEF(Perl_ck_exit) PERL_CKDEF(Perl_ck_ftst) PERL_CKDEF(Perl_ck_fun) -PERL_CKDEF(Perl_ck_fun_locale) PERL_CKDEF(Perl_ck_glob) PERL_CKDEF(Perl_ck_grep) PERL_CKDEF(Perl_ck_index) @@ -33,7 +32,6 @@ PERL_CKDEF(Perl_ck_rfun) PERL_CKDEF(Perl_ck_rvconst) PERL_CKDEF(Perl_ck_sassign) -PERL_CKDEF(Perl_ck_scmp) PERL_CKDEF(Perl_ck_select) PERL_CKDEF(Perl_ck_shift) PERL_CKDEF(Perl_ck_sort) diff -ruN perl-5.6.1/pp_sys.c AP629_source/pp_sys.c --- perl-5.6.1/pp_sys.c Thu Apr 5 21:38:46 2001 +++ AP629_source/pp_sys.c Thu Aug 23 17:30:27 2001 @@ -3143,7 +3143,7 @@ #else else if (*s & 128) { #ifdef USE_LOCALE - if ((PL_op->op_private & OPpLOCALE) && isALPHA_LC(*s)) + if (IN_LOCALE_RUNTIME && isALPHA_LC(*s)) continue; #endif /* utf8 characters don't count as odd */ @@ -3921,11 +3921,6 @@ #endif } -#if !defined(HAS_FORK) && defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS) - if (value >= 0) - my_exit(value); -#endif - SP = ORIGMARK; PUSHi(value); RETURN; @@ -4115,6 +4110,11 @@ static char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"}; static char *monname[] = {"Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"}; +#if defined(USE_REENTRANT_API) + struct tm tm_result; +# define localtime(x) localtime_r(x, &tm_result) +# define gmtime(x) gmtime_r(x, &tm_result) +#endif if (MAXARG < 1) (void)time(&when); diff -ruN perl-5.6.1/proto.h AP629_source/proto.h --- perl-5.6.1/proto.h Thu Apr 5 21:38:46 2001 +++ AP629_source/proto.h Thu Aug 23 17:30:27 2001 @@ -24,11 +24,11 @@ # endif #endif -#if defined(MYMALLOC) PERL_CALLCONV Malloc_t Perl_malloc(MEM_SIZE nbytes); PERL_CALLCONV Malloc_t Perl_calloc(MEM_SIZE elements, MEM_SIZE size); PERL_CALLCONV Malloc_t Perl_realloc(Malloc_t where, MEM_SIZE nbytes); PERL_CALLCONV Free_t Perl_mfree(Malloc_t where); +#if defined(MYMALLOC) PERL_CALLCONV MEM_SIZE Perl_malloced_size(void *p); #endif diff -ruN perl-5.6.1/regexec.c AP629_source/regexec.c --- perl-5.6.1/regexec.c Wed Mar 21 21:05:02 2001 +++ AP629_source/regexec.c Thu Aug 23 17:30:27 2001 @@ -385,18 +385,17 @@ || ( (prog->reganch & ROPT_ANCH_BOL) && !PL_multiline ) ); /* Check after \n? */ - if (!ml_anch) { - if ( !(prog->reganch & ROPT_ANCH_GPOS) /* Checked by the caller */ - /* SvCUR is not set on references: SvRV and SvPVX overlap */ - && sv && !SvROK(sv) - && (strpos != strbeg)) { - DEBUG_r(PerlIO_printf(Perl_debug_log, "Not at start...\n")); - goto fail; - } - if (prog->check_offset_min == prog->check_offset_max) { + if ((prog->check_offset_min == prog->check_offset_max) && !ml_anch) { /* Substring at constant offset from beg-of-str... */ I32 slen; + if ( !(prog->reganch & ROPT_ANCH_GPOS) /* Checked by the caller */ + /* SvCUR is not set on references: SvRV and SvPVX overlap */ + && sv && !SvROK(sv) + && (strpos != strbeg)) { + DEBUG_r(PerlIO_printf(Perl_debug_log, "Not at start...\n")); + goto fail; + } PL_regeol = strend; /* Used in HOP() */ s = HOPc(strpos, prog->check_offset_min); if (SvTAIL(check)) { @@ -422,7 +421,6 @@ && memNE(SvPVX(check), s, slen))) goto report_neq; goto success_at_start; - } } /* Match is anchored, but substr is not anchored wrt beg-of-str. */ s = strpos; diff -ruN perl-5.6.1/sv.c AP629_source/sv.c --- perl-5.6.1/sv.c Thu Apr 5 21:38:46 2001 +++ AP629_source/sv.c Thu Aug 23 17:30:27 2001 @@ -1955,11 +1955,11 @@ else numtype |= IS_NUMBER_TO_INT_BY_ATOL; - if (*s == '.' + if ( #ifdef USE_LOCALE_NUMERIC - || (specialradix = IS_NUMERIC_RADIX(s)) + (specialradix = IS_NUMERIC_RADIX(s, send)) || #endif - ) { + *s == '.') { #ifdef USE_LOCALE_NUMERIC if (specialradix) s += SvCUR(PL_numeric_radix_sv); @@ -1971,10 +1971,11 @@ s++; } } - else if (*s == '.' + else if ( #ifdef USE_LOCALE_NUMERIC - || (specialradix = IS_NUMERIC_RADIX(s)) + (specialradix = IS_NUMERIC_RADIX(s, send)) || #endif + *s == '.' ) { #ifdef USE_LOCALE_NUMERIC if (specialradix) @@ -7859,6 +7860,7 @@ PL_e_script = sv_dup_inc(proto_perl->Ie_script); PL_perldb = proto_perl->Iperldb; PL_perl_destruct_level = proto_perl->Iperl_destruct_level; + PL_exit_flags = proto_perl->Iexit_flags; /* magical thingies */ /* XXX time(&PL_basetime) when asked for? */ @@ -7899,6 +7901,7 @@ /* symbol tables */ PL_defstash = hv_dup_inc(proto_perl->Tdefstash); PL_curstash = hv_dup(proto_perl->Tcurstash); + PL_nullstash = hv_dup(proto_perl->Inullstash); PL_debstash = hv_dup(proto_perl->Idebstash); PL_globalstash = hv_dup(proto_perl->Iglobalstash); PL_curstname = sv_dup_inc(proto_perl->Icurstname); @@ -7998,7 +8001,7 @@ PL_origalen = proto_perl->Iorigalen; PL_pidstatus = newHV(); /* XXX flag for cloning? */ PL_osname = SAVEPV(proto_perl->Iosname); - PL_sh_path = SAVEPV(proto_perl->Ish_path); + PL_sh_path = proto_perl->Ish_path; /* XXX never deallocated */ PL_sighandlerp = proto_perl->Isighandlerp; @@ -8008,7 +8011,7 @@ #ifdef CSH PL_cshlen = proto_perl->Icshlen; - PL_cshname = SAVEPVN(proto_perl->Icshname, PL_cshlen); + PL_cshname = proto_perl->Icshname; /* XXX never deallocated */ #endif PL_lex_state = proto_perl->Ilex_state; diff -ruN perl-5.6.1/t/lib/bigfloat.t AP629_source/t/lib/bigfloat.t --- perl-5.6.1/t/lib/bigfloat.t Thu Feb 22 18:57:57 2001 +++ AP629_source/t/lib/bigfloat.t Thu Aug 23 17:30:27 2001 @@ -1,6 +1,6 @@ #!./perl -BEGIN { @INC = '../lib' } +BEGIN { unshift @INC, '../lib' if -d '../lib'; } require "bigfloat.pl"; $test = 0; diff -ruN perl-5.6.1/t/lib/bigfltpm.t AP629_source/t/lib/bigfltpm.t --- perl-5.6.1/t/lib/bigfltpm.t Sat Apr 7 23:09:16 2001 +++ AP629_source/t/lib/bigfltpm.t Thu Aug 23 17:30:27 2001 @@ -2,7 +2,7 @@ BEGIN { chdir 't' if -d 't'; - @INC = '../lib'; + unshift @INC, '../lib' if -d '../lib'; } use Math::BigFloat; diff -ruN perl-5.6.1/t/op/chop.t AP629_source/t/op/chop.t --- perl-5.6.1/t/op/chop.t Sun Mar 18 23:33:17 2001 +++ AP629_source/t/op/chop.t Thu Aug 23 17:30:27 2001 @@ -1,6 +1,6 @@ #!./perl -print "1..37\n"; +print "1..41\n"; # optimized @@ -116,3 +116,13 @@ my %stuff = (1..4); print chop(@stuff{1, 3}) eq '4' ? "ok 37\n" : "not ok 37\n"; + +# chomp should not stringify references unless it decides to modify them +$_ = []; +$/ = "\n"; +print chomp() == 0 ? "ok 38\n" : "not ok 38\n"; +print ref($_) eq "ARRAY" ? "ok 39\n" : "not ok 39\n"; + +$/ = ")"; # the last char of something like "ARRAY(0x80ff6e4)" +print chomp() == 1 ? "ok 40\n" : "not ok 40\n"; +print !ref($_) ? "ok 41\n" : "not ok 41\n"; diff -ruN perl-5.6.1/t/op/eval.t AP629_source/t/op/eval.t --- perl-5.6.1/t/op/eval.t Thu Feb 22 18:57:57 2001 +++ AP629_source/t/op/eval.t Thu Aug 23 17:30:27 2001 @@ -99,7 +99,7 @@ $x++; do_eval1('eval q[print "ok $x\n"]'); $x++; -do_eval1('sub { eval q[print "ok $x\n"] }->()'); +do_eval1('sub { print "# $x\n"; eval q[print "ok $x\n"] }->()'); $x++; # calls from within eval'' should clone outer lexicals @@ -112,7 +112,7 @@ $x++; do_eval2('eval q[print "ok $x\n"]'); $x++; -do_eval2('sub { eval q[print "ok $x\n"] }->()'); +do_eval2('sub { print "# $x\n"; eval q[print "ok $x\n"] }->()'); $x++; EOT diff -ruN perl-5.6.1/t/op/magic.t AP629_source/t/op/magic.t --- perl-5.6.1/t/op/magic.t Thu Mar 15 07:25:20 2001 +++ AP629_source/t/op/magic.t Thu Aug 23 17:30:27 2001 @@ -27,7 +27,7 @@ $Is_Cygwin = $^O eq 'cygwin'; $PERL = ($Is_MSWin32 ? '.\perl' : './perl'); -print "1..35\n"; +print "1..41\n"; eval '$ENV{"FOO"} = "hi there";'; # check that ENV is inited inside eval if ($Is_MSWin32) { ok 1, `cmd /x /c set FOO` eq "FOO=hi there\n"; } @@ -226,3 +226,10 @@ ok "34 # skipped: no caseless %ENV support",1; ok "35 # skipped: no caseless %ENV support",1; } + +# change#9390 not yet merged +print "ok $_\n" for 36..38; + +ok 39, $^S == 0; +eval { ok 40, $^S == 1 }; +ok 41, $^S == 0; diff -ruN perl-5.6.1/t/op/misc.t AP629_source/t/op/misc.t --- perl-5.6.1/t/op/misc.t Thu Feb 22 18:57:58 2001 +++ AP629_source/t/op/misc.t Thu Aug 23 17:30:27 2001 @@ -258,6 +258,15 @@ EXPECT 2 2 2 ######## +# used to attach defelem magic too all immortal values, +# which made restore of local $_ fail. +foo(2>1); +sub foo { bar() for @_; } +sub bar { local $_; } +print "ok\n"; +EXPECT +ok +######## @a = ($a, $b, $c, $d) = (5, 6); print "ok\n" if ($a[0] == 5 and $a[1] == 6 and !defined $a[2] and !defined $a[3]); @@ -566,6 +575,40 @@ EXPECT aba\ba\b ######## +# lexicals declared after the myeval() definition should not be visible +# within it +sub myeval { eval $_[0] } +my $foo = "ok 2\n"; +myeval('sub foo { local $foo = "ok 1\n"; print $foo; }'); +die $@ if $@; +foo(); +print $foo; +EXPECT +ok 1 +ok 2 +######## +# lexicals outside an eval"" should be visible inside subroutine definitions +# within it +eval <<'EOT'; die $@ if $@; +{ + my $X = "ok\n"; + eval 'sub Y { print $X }'; die $@ if $@; + Y(); +} +EOT +EXPECT +ok +######## +# test that closures generated by eval"" hold on to the CV of the eval"" +# for their entire lifetime +$code = eval q[ + sub { eval '$x = "ok 1\n"'; } +]; +&{$code}(); +print $x; +EXPECT +ok 1 +######## # This test is here instead of pragma/locale.t because # the bug depends on in the internal state of the locale # settings and pragma/locale messes up that state pretty badly. @@ -601,3 +644,15 @@ print "$_ $s\n"; } EXPECT +######## +# Bug 20010515.004 +my @h = 1 .. 10; +bad(@h); +sub bad { + undef @h; + print "O"; + print for @_; + print "K"; +} +EXPECT +OK diff -ruN perl-5.6.1/t/op/numconvert.t AP629_source/t/op/numconvert.t --- perl-5.6.1/t/op/numconvert.t Thu Feb 22 18:57:58 2001 +++ AP629_source/t/op/numconvert.t Thu Aug 23 17:30:27 2001 @@ -37,7 +37,7 @@ BEGIN { chdir 't' if -d 't'; - @INC = '../lib'; + unshift @INC, '../lib' if -d '../lib'; } use strict 'vars'; diff -ruN perl-5.6.1/t/op/override.t AP629_source/t/op/override.t --- perl-5.6.1/t/op/override.t Wed Dec 31 16:00:00 1969 +++ AP629_source/t/op/override.t Thu Aug 23 17:30:27 2001 @@ -0,0 +1,63 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '.'; + push @INC, '../lib'; +} + +print "1..10\n"; + +# +# This file tries to test builtin override using CORE::GLOBAL +# +my $dirsep = "/"; + +BEGIN { package Foo; *main::getlogin = sub { "kilroy"; } } + +print "not " unless getlogin eq "kilroy"; +print "ok 1\n"; + +my $t = 42; +BEGIN { *CORE::GLOBAL::time = sub () { $t; } } + +print "not " unless 45 == time + 3; +print "ok 2\n"; + +# +# require has special behaviour +# +my $r; +BEGIN { *CORE::GLOBAL::require = sub { $r = shift; 1; } } + +require Foo; +print "not " unless $r eq "Foo.pm"; +print "ok 3\n"; + +require Foo::Bar; +print "not " unless $r eq join($dirsep, "Foo", "Bar.pm"); +print "ok 4\n"; + +require 'Foo'; +print "not " unless $r eq "Foo"; +print "ok 5\n"; + +require 5.6; +print "not " unless $r eq "5.6"; +print "ok 6\n"; + +require v5.6; +print "not " unless $r == 5.006 && $r eq "\x05\x06"; +print "ok 7\n"; + +eval "use Foo"; +print "not " unless $r eq "Foo.pm"; +print "ok 8\n"; + +eval "use Foo::Bar"; +print "not " unless $r eq join($dirsep, "Foo", "Bar.pm"); +print "ok 9\n"; + +eval "use 5.6"; +print "not " unless $r eq "5.6"; +print "ok 10\n"; diff -ruN perl-5.6.1/t/op/pat.t AP629_source/t/op/pat.t --- perl-5.6.1/t/op/pat.t Thu Mar 15 07:25:20 2001 +++ AP629_source/t/op/pat.t Thu Aug 23 17:30:27 2001 @@ -4,7 +4,7 @@ # the format supported by op/regexp.t. If you want to add a test # that does fit that format, add it to op/re_tests, not here. -print "1..231\n"; +print "1..238\n"; BEGIN { chdir 't' if -d 't'; @@ -1128,3 +1128,48 @@ print "ok $test\n"; $test++; } + +{ + # bugid 20010410.006 + for my $rx ( + '/(.*?)\{(.*?)\}/csg', + '/(.*?)\{(.*?)\}/cg', + '/(.*?)\{(.*?)\}/sg', + '/(.*?)\{(.*?)\}/g', + '/(.+?)\{(.+?)\}/csg', + ) + { + my($input, $i); + + $i = 0; + $input = "a{b}c{d}"; + eval < + my $r; + foreach my $pat ( qr/\s+/, qr/ll/ ) { + $r = join ':' => split($pat, "hello cruel world"); + } + print "not " unless $r eq "he:o cruel world"; + print "ok 30\n"; +} diff -ruN perl-5.6.1/t/op/tiehandle.t AP629_source/t/op/tiehandle.t --- perl-5.6.1/t/op/tiehandle.t Thu Feb 22 18:57:58 2001 +++ AP629_source/t/op/tiehandle.t Thu Aug 23 17:30:27 2001 @@ -77,7 +77,7 @@ use Symbol; -print "1..33\n"; +print "1..35\n"; my $fh = gensym; @@ -165,3 +165,27 @@ $r = print STDERR @expect[2,3]; ok($r == 1); } + +{ + # Test for change #11536 + package Foo; + use strict; + sub TIEHANDLE { bless {} } + my $cnt = 'a'; + sub READ { + $_[1] = $cnt++; + 1; + } + sub do_read { + my $fh = shift; + read $fh, my $buff, 1; + main::ok(1); + } + $|=1; + tie *STDIN, 'Foo'; + read STDIN, my $buff, 1; + main::ok(1); + do_read(\*STDIN); + untie *STDIN; +} + diff -ruN perl-5.6.1/t/pod/find.t AP629_source/t/pod/find.t --- perl-5.6.1/t/pod/find.t Sat Apr 7 23:09:16 2001 +++ AP629_source/t/pod/find.t Thu Aug 23 17:30:27 2001 @@ -30,7 +30,8 @@ print "### searching $lib_dir\n"; my %pods = pod_find("$lib_dir"); my $result = join(",", sort values %pods); -print "### found $result\n"; +my $printresult = join("\n### ", sort values %pods); +print "### found $printresult\n"; my $compare = join(',', qw( Checker Find @@ -93,7 +94,7 @@ print "### found $result\n"; if ($^O eq 'VMS') { # privlib is perl_root:[lib] unfortunately - $compare = "/lib/pod/perlfunc.pod"; + $compare = "/pod/perlfunc.pod"; $result = VMS::Filespec::unixify($result); $result =~ s/perl_root\///i; $result =~ s/^\.\.//; # needed under `mms test` diff -ruN perl-5.6.1/t/pragma/locale.t AP629_source/t/pragma/locale.t --- perl-5.6.1/t/pragma/locale.t Thu Feb 22 18:57:58 2001 +++ AP629_source/t/pragma/locale.t Thu Aug 23 17:30:27 2001 @@ -9,6 +9,7 @@ print "1..0\n"; exit; } + $| = 1; } use strict; @@ -643,7 +644,7 @@ tryneoalpha($Locale, 107, $c == $d); { - no locale; +# no locale; # XXX did this ever work correctly? my $e = "$x"; diff -ruN perl-5.6.1/t/pragma/sub_lval.t AP629_source/t/pragma/sub_lval.t --- perl-5.6.1/t/pragma/sub_lval.t Thu Feb 22 18:57:58 2001 +++ AP629_source/t/pragma/sub_lval.t Thu Aug 23 17:30:27 2001 @@ -430,18 +430,20 @@ print "# '$newvar'.\nnot " unless $newvar eq "12"; print "ok 47\n"; -# Testing DWIM of foo = bar; -sub foo : lvalue { - $a; -} -$a = "not ok 48\n"; -foo = "ok 48\n"; -print $a; - -open bar, ">nothing" or die $!; -bar = *STDOUT; -print bar "ok 49\n"; -unlink "nothing"; +## Testing DWIM of foo = bar; +#sub foo : lvalue { +# $a; +#} +#$a = "not ok 48\n"; +#foo = "ok 48\n"; +#print $a; +# +#open bar, ">nothing" or die $!; +#bar = *STDOUT; +#print bar "ok 49\n"; +#unlink "nothing"; +print "ok 48\n"; +print "ok 49\n"; { my %hash; my @array; diff -ruN perl-5.6.1/t/pragma/warn/doio AP629_source/t/pragma/warn/doio --- perl-5.6.1/t/pragma/warn/doio Thu Feb 22 18:57:58 2001 +++ AP629_source/t/pragma/warn/doio Thu Aug 23 17:30:27 2001 @@ -163,6 +163,11 @@ OPTION regex Can't exec "lskdjfalksdjfdjfkls": .+ ######## +# doio.c [win32_execvp] +use warnings 'exec' ; +exec $^X, "-e0" ; +EXPECT +######## # doio.c [Perl_do_exec3] use warnings 'io' ; exec "lskdjfalksdjfdjfkls", "abc" ; diff -ruN perl-5.6.1/t/pragma/warn/universal AP629_source/t/pragma/warn/universal --- perl-5.6.1/t/pragma/warn/universal Thu Feb 22 18:57:58 2001 +++ AP629_source/t/pragma/warn/universal Thu Aug 23 17:30:27 2001 @@ -12,5 +12,3 @@ UNIVERSAL::isa $a, Jim ; EXPECT Can't locate package Joe for @main::ISA at - line 5. -Can't locate package Joe for @main::ISA. -Can't locate package Joe for @main::ISA. diff -ruN perl-5.6.1/t/run/runenv.t AP629_source/t/run/runenv.t --- perl-5.6.1/t/run/runenv.t Sat Mar 3 11:53:20 2001 +++ AP629_source/t/run/runenv.t Thu Aug 23 17:30:27 2001 @@ -19,7 +19,7 @@ my $PERL = './perl'; my $FAILURE_CODE = 119; -print "1..9\n"; +print "1..10\n"; # Run perl with specified environment and arguments returns a list. # First element is true iff Perl's stdout and stderr match the @@ -138,6 +138,11 @@ ['-e', 'print "ok" if $INC{"strict.pm"} and $INC{"warnings.pm"}'], "ok", ""); + +try($T++, {PERL5OPT => '-w -w'}, + ['-e', 'print $ENV{PERL5OPT}'], + '-w -w', + ''); print "# ", $T-1, " tests total.\n"; diff -ruN perl-5.6.1/thread.h AP629_source/thread.h --- perl-5.6.1/thread.h Thu Feb 22 18:57:58 2001 +++ AP629_source/thread.h Thu Aug 23 17:30:27 2001 @@ -33,6 +33,7 @@ # define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t) # endif # if defined(__hpux) && defined(__ux_version) && __ux_version <= 1020 +# define PTHREAD_ATFORK(prepare,parent,child) NOOP # define pthread_attr_init(a) pthread_attr_create(a) /* XXX pthread_setdetach_np() missing in DCE threads on HP-UX 10.20 */ # define PTHREAD_ATTR_SETDETACHSTATE(a,s) (0) @@ -276,6 +277,11 @@ } STMT_END #endif +#ifndef PTHREAD_ATFORK +# define PTHREAD_ATFORK(prepare,parent,child) \ + pthread_atfork(prepare,parent,child) +#endif + #ifndef THREAD_RET_TYPE # define THREAD_RET_TYPE void * # define THREAD_RET_CAST(p) ((void *)(p)) @@ -429,4 +435,8 @@ #ifndef INIT_THREADS # define INIT_THREADS NOOP +#endif + +#ifndef PTHREAD_ATFORK +# define PTHREAD_ATFORK(prepare,parent,child) NOOP #endif diff -ruN perl-5.6.1/toke.c AP629_source/toke.c --- perl-5.6.1/toke.c Sun Apr 1 01:00:23 2001 +++ AP629_source/toke.c Thu Aug 23 17:30:27 2001 @@ -1302,7 +1302,7 @@ else if (*s == '$') { if (!PL_lex_inpat) /* not a regexp, so $ must be var */ break; - if (s + 1 < send && !strchr("()| \n\t", s[1])) + if (s + 1 < send && !strchr("()| \r\n\t", s[1])) break; /* in regexp, $ might be tail anchor */ } @@ -5578,7 +5578,7 @@ if (strEQ(d,"rindex")) return -KEY_rindex; break; case 7: - if (strEQ(d,"require")) return -KEY_require; + if (strEQ(d,"require")) return KEY_require; if (strEQ(d,"reverse")) return -KEY_reverse; if (strEQ(d,"readdir")) return -KEY_readdir; break; diff -ruN perl-5.6.1/util.c AP629_source/util.c --- perl-5.6.1/util.c Thu Apr 5 21:38:46 2001 +++ AP629_source/util.c Thu Aug 23 17:30:28 2001 @@ -338,6 +338,37 @@ #endif /* LEAKTEST */ +/* These must be defined when not using Perl's malloc for binary + * compatibility */ + +#ifndef MYMALLOC + +Malloc_t Perl_malloc (MEM_SIZE nbytes) +{ + dTHXs; + return PerlMem_malloc(nbytes); +} + +Malloc_t Perl_calloc (MEM_SIZE elements, MEM_SIZE size) +{ + dTHXs; + return PerlMem_calloc(elements, size); +} + +Malloc_t Perl_realloc (Malloc_t where, MEM_SIZE nbytes) +{ + dTHXs; + return PerlMem_realloc(where, nbytes); +} + +Free_t Perl_mfree (Malloc_t where) +{ + dTHXs; + PerlMem_free(where); +} + +#endif + /* copy a string up to some (non-backslashed) delimiter, if any */ char * @@ -3872,7 +3903,7 @@ { NV x = 0.0; #ifdef USE_LOCALE_NUMERIC - if ((PL_hints & HINT_LOCALE) && PL_numeric_local) { + if (PL_numeric_local && IN_LOCALE) { NV y; Perl_atof2(s, x); diff -ruN perl-5.6.1/utils/h2ph.PL AP629_source/utils/h2ph.PL --- perl-5.6.1/utils/h2ph.PL Sun Mar 18 19:03:34 2001 +++ AP629_source/utils/h2ph.PL Thu Aug 23 17:30:28 2001 @@ -563,9 +563,9 @@ print PREAMBLE "# $_=$define{$_}\n"; } - if ($define{$_} =~ /^\d+$/) { + if ($define{$_} =~ /^(\d+)U?L{0,2}$/i) { print PREAMBLE - "unless (defined &$_) { sub $_() { $define{$_} } }\n\n"; + "unless (defined &$_) { sub $_() { $1 } }\n\n"; } elsif ($define{$_} =~ /^\w+$/) { print PREAMBLE "unless (defined &$_) { sub $_() { &$define{$_} } }\n\n"; diff -ruN perl-5.6.1/utils/h2xs.PL AP629_source/utils/h2xs.PL --- perl-5.6.1/utils/h2xs.PL Thu Feb 22 18:57:58 2001 +++ AP629_source/utils/h2xs.PL Thu Aug 23 17:30:28 2001 @@ -1209,12 +1209,25 @@ errno = 0; END - print $fh <<"END" if $off; - if ($offarg + $off >= len ) { + if ($off) { + my $null = 0; + + foreach my $letter (keys %leading) { + if ($letter eq '') { + $null = 1; + last; + } + } + + my $cmp = $null ? '>' : '>='; + + print $fh <<"END" + if ($offarg + $off $cmp len ) { errno = EINVAL; return 0; } END + } print $fh <<"END"; switch (name[$offarg + $off]) { @@ -1789,7 +1802,10 @@ Put the correct copyright and licence information here. -Copyright (C) $thisyear $author blah blah blah +Copyright (C) $thisyear $author + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. _RMEND_ close(RM) || die "Can't close $ext$modpname/README: $!\n"; diff -ruN perl-5.6.1/vms/perly_c.vms AP629_source/vms/perly_c.vms --- perl-5.6.1/vms/perly_c.vms Thu Feb 22 18:57:58 2001 +++ AP629_source/vms/perly_c.vms Thu Aug 23 17:30:28 2001 @@ -1570,12 +1570,12 @@ #if defined(YYDEBUG) && defined(DEBUGGING) yydebug = (PL_debug & 1); #endif - PL_expect = XSTATE; + PL_expect = XSTATE; yyval.ival = block_start(TRUE); } break; case 2: #line 132 "perly.y" -{ newPROG(yyvsp[0].opval); } +{ newPROG(block_end(yyvsp[-1].ival,yyvsp[0].opval)); } break; case 3: #line 136 "perly.y" diff -ruN perl-5.6.1/win32/Makefile AP629_source/win32/Makefile --- perl-5.6.1/win32/Makefile Wed May 2 00:08:14 2001 +++ AP629_source/win32/Makefile Thu Aug 23 17:30:28 2001 @@ -17,8 +17,8 @@ # Set these to wherever you want "nmake install" to put your newly # built perl. Setting it to a path with spaces is NOT recommended. # -INST_DRV = c: -INST_TOP = $(INST_DRV)\perl +INST_DRV = p: +INST_TOP = $(INST_DRV)\Apps\temp # # uncomment one of the following lines if you are using either @@ -57,7 +57,7 @@ # If you don't enable one of these, the crypt() builtin will fail to work. # (Generally not critical.) # -#CRYPT_SRC = fcrypt.c +CRYPT_SRC = fcrypt.c #CRYPT_LIB = fcrypt.lib # @@ -71,7 +71,7 @@ # the ActivePerl configuration will get you fork() emulation at the # cost of some added bloat. # -#BUILD_FLAVOR = ActivePerl +BUILD_FLAVOR = ActivePerl # # uncomment next line if you want debug version of perl (big and slow). @@ -208,7 +208,7 @@ # set this to your email address (perl will guess a value from # from your loginname and your hostname, which may not be right) # -#EMAIL = +EMAIL = support@ActiveState.com ## ## Build configuration ends. @@ -373,8 +373,8 @@ LIBC = PerlCRT.lib !ENDIF -PERLEXE_RES = -PERLDLL_RES = +PERLEXE_RES = perlexe.res +PERLDLL_RES = perldll.res !IF "$(CFG)" == "Debug" ! IF "$(CCTYPE)" == "MSVC20" @@ -722,6 +722,7 @@ "INST_ARCH=$(INST_ARCH)" \ "archname=$(ARCHNAME)" \ "cc=$(CC)" \ + "ld=$(LINK32)" \ "ccflags=-nologo $(OPTIMIZE:"=\") $(DEFINES) $(BUILDOPT)" \ "cf_email=$(EMAIL)" \ "d_crypt=$(D_CRYPT)" \ diff -ruN perl-5.6.1/win32/fcrypt.c AP629_source/win32/fcrypt.c --- perl-5.6.1/win32/fcrypt.c Wed Dec 31 16:00:00 1969 +++ AP629_source/win32/fcrypt.c Thu Aug 23 17:30:28 2001 @@ -0,0 +1,578 @@ +/* fcrypt.c */ +/* Copyright (C) 1993 Eric Young - see README for more details */ +#include + +/* Eric Young. + * This version of crypt has been developed from my MIT compatable + * DES library. + * The library is available at pub/DES at ftp.psy.uq.oz.au + * eay@psych.psy.uq.oz.au + */ + +typedef unsigned char des_cblock[8]; + +typedef struct des_ks_struct + { + union { + des_cblock _; + /* make sure things are correct size on machines with + * 8 byte longs */ + unsigned long pad[2]; + } ks; +#define _ ks._ + } des_key_schedule[16]; + +#define DES_KEY_SZ (sizeof(des_cblock)) +#define DES_ENCRYPT 1 +#define DES_DECRYPT 0 + +#define ITERATIONS 16 +#define HALF_ITERATIONS 8 + +#define c2l(c,l) (l =((unsigned long)(*((c)++))) , \ + l|=((unsigned long)(*((c)++)))<< 8, \ + l|=((unsigned long)(*((c)++)))<<16, \ + l|=((unsigned long)(*((c)++)))<<24) + +#define l2c(l,c) (*((c)++)=(unsigned char)(((l) )&0xff), \ + *((c)++)=(unsigned char)(((l)>> 8)&0xff), \ + *((c)++)=(unsigned char)(((l)>>16)&0xff), \ + *((c)++)=(unsigned char)(((l)>>24)&0xff)) + +static unsigned long SPtrans[8][64]={ +/* nibble 0 */ +0x00820200, 0x00020000, 0x80800000, 0x80820200, +0x00800000, 0x80020200, 0x80020000, 0x80800000, +0x80020200, 0x00820200, 0x00820000, 0x80000200, +0x80800200, 0x00800000, 0x00000000, 0x80020000, +0x00020000, 0x80000000, 0x00800200, 0x00020200, +0x80820200, 0x00820000, 0x80000200, 0x00800200, +0x80000000, 0x00000200, 0x00020200, 0x80820000, +0x00000200, 0x80800200, 0x80820000, 0x00000000, +0x00000000, 0x80820200, 0x00800200, 0x80020000, +0x00820200, 0x00020000, 0x80000200, 0x00800200, +0x80820000, 0x00000200, 0x00020200, 0x80800000, +0x80020200, 0x80000000, 0x80800000, 0x00820000, +0x80820200, 0x00020200, 0x00820000, 0x80800200, +0x00800000, 0x80000200, 0x80020000, 0x00000000, +0x00020000, 0x00800000, 0x80800200, 0x00820200, +0x80000000, 0x80820000, 0x00000200, 0x80020200, +/* nibble 1 */ +0x10042004, 0x00000000, 0x00042000, 0x10040000, +0x10000004, 0x00002004, 0x10002000, 0x00042000, +0x00002000, 0x10040004, 0x00000004, 0x10002000, +0x00040004, 0x10042000, 0x10040000, 0x00000004, +0x00040000, 0x10002004, 0x10040004, 0x00002000, +0x00042004, 0x10000000, 0x00000000, 0x00040004, +0x10002004, 0x00042004, 0x10042000, 0x10000004, +0x10000000, 0x00040000, 0x00002004, 0x10042004, +0x00040004, 0x10042000, 0x10002000, 0x00042004, +0x10042004, 0x00040004, 0x10000004, 0x00000000, +0x10000000, 0x00002004, 0x00040000, 0x10040004, +0x00002000, 0x10000000, 0x00042004, 0x10002004, +0x10042000, 0x00002000, 0x00000000, 0x10000004, +0x00000004, 0x10042004, 0x00042000, 0x10040000, +0x10040004, 0x00040000, 0x00002004, 0x10002000, +0x10002004, 0x00000004, 0x10040000, 0x00042000, +/* nibble 2 */ +0x41000000, 0x01010040, 0x00000040, 0x41000040, +0x40010000, 0x01000000, 0x41000040, 0x00010040, +0x01000040, 0x00010000, 0x01010000, 0x40000000, +0x41010040, 0x40000040, 0x40000000, 0x41010000, +0x00000000, 0x40010000, 0x01010040, 0x00000040, +0x40000040, 0x41010040, 0x00010000, 0x41000000, +0x41010000, 0x01000040, 0x40010040, 0x01010000, +0x00010040, 0x00000000, 0x01000000, 0x40010040, +0x01010040, 0x00000040, 0x40000000, 0x00010000, +0x40000040, 0x40010000, 0x01010000, 0x41000040, +0x00000000, 0x01010040, 0x00010040, 0x41010000, +0x40010000, 0x01000000, 0x41010040, 0x40000000, +0x40010040, 0x41000000, 0x01000000, 0x41010040, +0x00010000, 0x01000040, 0x41000040, 0x00010040, +0x01000040, 0x00000000, 0x41010000, 0x40000040, +0x41000000, 0x40010040, 0x00000040, 0x01010000, +/* nibble 3 */ +0x00100402, 0x04000400, 0x00000002, 0x04100402, +0x00000000, 0x04100000, 0x04000402, 0x00100002, +0x04100400, 0x04000002, 0x04000000, 0x00000402, +0x04000002, 0x00100402, 0x00100000, 0x04000000, +0x04100002, 0x00100400, 0x00000400, 0x00000002, +0x00100400, 0x04000402, 0x04100000, 0x00000400, +0x00000402, 0x00000000, 0x00100002, 0x04100400, +0x04000400, 0x04100002, 0x04100402, 0x00100000, +0x04100002, 0x00000402, 0x00100000, 0x04000002, +0x00100400, 0x04000400, 0x00000002, 0x04100000, +0x04000402, 0x00000000, 0x00000400, 0x00100002, +0x00000000, 0x04100002, 0x04100400, 0x00000400, +0x04000000, 0x04100402, 0x00100402, 0x00100000, +0x04100402, 0x00000002, 0x04000400, 0x00100402, +0x00100002, 0x00100400, 0x04100000, 0x04000402, +0x00000402, 0x04000000, 0x04000002, 0x04100400, +/* nibble 4 */ +0x02000000, 0x00004000, 0x00000100, 0x02004108, +0x02004008, 0x02000100, 0x00004108, 0x02004000, +0x00004000, 0x00000008, 0x02000008, 0x00004100, +0x02000108, 0x02004008, 0x02004100, 0x00000000, +0x00004100, 0x02000000, 0x00004008, 0x00000108, +0x02000100, 0x00004108, 0x00000000, 0x02000008, +0x00000008, 0x02000108, 0x02004108, 0x00004008, +0x02004000, 0x00000100, 0x00000108, 0x02004100, +0x02004100, 0x02000108, 0x00004008, 0x02004000, +0x00004000, 0x00000008, 0x02000008, 0x02000100, +0x02000000, 0x00004100, 0x02004108, 0x00000000, +0x00004108, 0x02000000, 0x00000100, 0x00004008, +0x02000108, 0x00000100, 0x00000000, 0x02004108, +0x02004008, 0x02004100, 0x00000108, 0x00004000, +0x00004100, 0x02004008, 0x02000100, 0x00000108, +0x00000008, 0x00004108, 0x02004000, 0x02000008, +/* nibble 5 */ +0x20000010, 0x00080010, 0x00000000, 0x20080800, +0x00080010, 0x00000800, 0x20000810, 0x00080000, +0x00000810, 0x20080810, 0x00080800, 0x20000000, +0x20000800, 0x20000010, 0x20080000, 0x00080810, +0x00080000, 0x20000810, 0x20080010, 0x00000000, +0x00000800, 0x00000010, 0x20080800, 0x20080010, +0x20080810, 0x20080000, 0x20000000, 0x00000810, +0x00000010, 0x00080800, 0x00080810, 0x20000800, +0x00000810, 0x20000000, 0x20000800, 0x00080810, +0x20080800, 0x00080010, 0x00000000, 0x20000800, +0x20000000, 0x00000800, 0x20080010, 0x00080000, +0x00080010, 0x20080810, 0x00080800, 0x00000010, +0x20080810, 0x00080800, 0x00080000, 0x20000810, +0x20000010, 0x20080000, 0x00080810, 0x00000000, +0x00000800, 0x20000010, 0x20000810, 0x20080800, +0x20080000, 0x00000810, 0x00000010, 0x20080010, +/* nibble 6 */ +0x00001000, 0x00000080, 0x00400080, 0x00400001, +0x00401081, 0x00001001, 0x00001080, 0x00000000, +0x00400000, 0x00400081, 0x00000081, 0x00401000, +0x00000001, 0x00401080, 0x00401000, 0x00000081, +0x00400081, 0x00001000, 0x00001001, 0x00401081, +0x00000000, 0x00400080, 0x00400001, 0x00001080, +0x00401001, 0x00001081, 0x00401080, 0x00000001, +0x00001081, 0x00401001, 0x00000080, 0x00400000, +0x00001081, 0x00401000, 0x00401001, 0x00000081, +0x00001000, 0x00000080, 0x00400000, 0x00401001, +0x00400081, 0x00001081, 0x00001080, 0x00000000, +0x00000080, 0x00400001, 0x00000001, 0x00400080, +0x00000000, 0x00400081, 0x00400080, 0x00001080, +0x00000081, 0x00001000, 0x00401081, 0x00400000, +0x00401080, 0x00000001, 0x00001001, 0x00401081, +0x00400001, 0x00401080, 0x00401000, 0x00001001, +/* nibble 7 */ +0x08200020, 0x08208000, 0x00008020, 0x00000000, +0x08008000, 0x00200020, 0x08200000, 0x08208020, +0x00000020, 0x08000000, 0x00208000, 0x00008020, +0x00208020, 0x08008020, 0x08000020, 0x08200000, +0x00008000, 0x00208020, 0x00200020, 0x08008000, +0x08208020, 0x08000020, 0x00000000, 0x00208000, +0x08000000, 0x00200000, 0x08008020, 0x08200020, +0x00200000, 0x00008000, 0x08208000, 0x00000020, +0x00200000, 0x00008000, 0x08000020, 0x08208020, +0x00008020, 0x08000000, 0x00000000, 0x00208000, +0x08200020, 0x08008020, 0x08008000, 0x00200020, +0x08208000, 0x00000020, 0x00200020, 0x08008000, +0x08208020, 0x00200000, 0x08200000, 0x08000020, +0x00208000, 0x00008020, 0x08008020, 0x08200000, +0x00000020, 0x08208000, 0x00208020, 0x00000000, +0x08000000, 0x08200020, 0x00008000, 0x00208020}; +static unsigned long skb[8][64]={ +/* for C bits (numbered as per FIPS 46) 1 2 3 4 5 6 */ +0x00000000,0x00000010,0x20000000,0x20000010, +0x00010000,0x00010010,0x20010000,0x20010010, +0x00000800,0x00000810,0x20000800,0x20000810, +0x00010800,0x00010810,0x20010800,0x20010810, +0x00000020,0x00000030,0x20000020,0x20000030, +0x00010020,0x00010030,0x20010020,0x20010030, +0x00000820,0x00000830,0x20000820,0x20000830, +0x00010820,0x00010830,0x20010820,0x20010830, +0x00080000,0x00080010,0x20080000,0x20080010, +0x00090000,0x00090010,0x20090000,0x20090010, +0x00080800,0x00080810,0x20080800,0x20080810, +0x00090800,0x00090810,0x20090800,0x20090810, +0x00080020,0x00080030,0x20080020,0x20080030, +0x00090020,0x00090030,0x20090020,0x20090030, +0x00080820,0x00080830,0x20080820,0x20080830, +0x00090820,0x00090830,0x20090820,0x20090830, +/* for C bits (numbered as per FIPS 46) 7 8 10 11 12 13 */ +0x00000000,0x02000000,0x00002000,0x02002000, +0x00200000,0x02200000,0x00202000,0x02202000, +0x00000004,0x02000004,0x00002004,0x02002004, +0x00200004,0x02200004,0x00202004,0x02202004, +0x00000400,0x02000400,0x00002400,0x02002400, +0x00200400,0x02200400,0x00202400,0x02202400, +0x00000404,0x02000404,0x00002404,0x02002404, +0x00200404,0x02200404,0x00202404,0x02202404, +0x10000000,0x12000000,0x10002000,0x12002000, +0x10200000,0x12200000,0x10202000,0x12202000, +0x10000004,0x12000004,0x10002004,0x12002004, +0x10200004,0x12200004,0x10202004,0x12202004, +0x10000400,0x12000400,0x10002400,0x12002400, +0x10200400,0x12200400,0x10202400,0x12202400, +0x10000404,0x12000404,0x10002404,0x12002404, +0x10200404,0x12200404,0x10202404,0x12202404, +/* for C bits (numbered as per FIPS 46) 14 15 16 17 19 20 */ +0x00000000,0x00000001,0x00040000,0x00040001, +0x01000000,0x01000001,0x01040000,0x01040001, +0x00000002,0x00000003,0x00040002,0x00040003, +0x01000002,0x01000003,0x01040002,0x01040003, +0x00000200,0x00000201,0x00040200,0x00040201, +0x01000200,0x01000201,0x01040200,0x01040201, +0x00000202,0x00000203,0x00040202,0x00040203, +0x01000202,0x01000203,0x01040202,0x01040203, +0x08000000,0x08000001,0x08040000,0x08040001, +0x09000000,0x09000001,0x09040000,0x09040001, +0x08000002,0x08000003,0x08040002,0x08040003, +0x09000002,0x09000003,0x09040002,0x09040003, +0x08000200,0x08000201,0x08040200,0x08040201, +0x09000200,0x09000201,0x09040200,0x09040201, +0x08000202,0x08000203,0x08040202,0x08040203, +0x09000202,0x09000203,0x09040202,0x09040203, +/* for C bits (numbered as per FIPS 46) 21 23 24 26 27 28 */ +0x00000000,0x00100000,0x00000100,0x00100100, +0x00000008,0x00100008,0x00000108,0x00100108, +0x00001000,0x00101000,0x00001100,0x00101100, +0x00001008,0x00101008,0x00001108,0x00101108, +0x04000000,0x04100000,0x04000100,0x04100100, +0x04000008,0x04100008,0x04000108,0x04100108, +0x04001000,0x04101000,0x04001100,0x04101100, +0x04001008,0x04101008,0x04001108,0x04101108, +0x00020000,0x00120000,0x00020100,0x00120100, +0x00020008,0x00120008,0x00020108,0x00120108, +0x00021000,0x00121000,0x00021100,0x00121100, +0x00021008,0x00121008,0x00021108,0x00121108, +0x04020000,0x04120000,0x04020100,0x04120100, +0x04020008,0x04120008,0x04020108,0x04120108, +0x04021000,0x04121000,0x04021100,0x04121100, +0x04021008,0x04121008,0x04021108,0x04121108, +/* for D bits (numbered as per FIPS 46) 1 2 3 4 5 6 */ +0x00000000,0x10000000,0x00010000,0x10010000, +0x00000004,0x10000004,0x00010004,0x10010004, +0x20000000,0x30000000,0x20010000,0x30010000, +0x20000004,0x30000004,0x20010004,0x30010004, +0x00100000,0x10100000,0x00110000,0x10110000, +0x00100004,0x10100004,0x00110004,0x10110004, +0x20100000,0x30100000,0x20110000,0x30110000, +0x20100004,0x30100004,0x20110004,0x30110004, +0x00001000,0x10001000,0x00011000,0x10011000, +0x00001004,0x10001004,0x00011004,0x10011004, +0x20001000,0x30001000,0x20011000,0x30011000, +0x20001004,0x30001004,0x20011004,0x30011004, +0x00101000,0x10101000,0x00111000,0x10111000, +0x00101004,0x10101004,0x00111004,0x10111004, +0x20101000,0x30101000,0x20111000,0x30111000, +0x20101004,0x30101004,0x20111004,0x30111004, +/* for D bits (numbered as per FIPS 46) 8 9 11 12 13 14 */ +0x00000000,0x08000000,0x00000008,0x08000008, +0x00000400,0x08000400,0x00000408,0x08000408, +0x00020000,0x08020000,0x00020008,0x08020008, +0x00020400,0x08020400,0x00020408,0x08020408, +0x00000001,0x08000001,0x00000009,0x08000009, +0x00000401,0x08000401,0x00000409,0x08000409, +0x00020001,0x08020001,0x00020009,0x08020009, +0x00020401,0x08020401,0x00020409,0x08020409, +0x02000000,0x0A000000,0x02000008,0x0A000008, +0x02000400,0x0A000400,0x02000408,0x0A000408, +0x02020000,0x0A020000,0x02020008,0x0A020008, +0x02020400,0x0A020400,0x02020408,0x0A020408, +0x02000001,0x0A000001,0x02000009,0x0A000009, +0x02000401,0x0A000401,0x02000409,0x0A000409, +0x02020001,0x0A020001,0x02020009,0x0A020009, +0x02020401,0x0A020401,0x02020409,0x0A020409, +/* for D bits (numbered as per FIPS 46) 16 17 18 19 20 21 */ +0x00000000,0x00000100,0x00080000,0x00080100, +0x01000000,0x01000100,0x01080000,0x01080100, +0x00000010,0x00000110,0x00080010,0x00080110, +0x01000010,0x01000110,0x01080010,0x01080110, +0x00200000,0x00200100,0x00280000,0x00280100, +0x01200000,0x01200100,0x01280000,0x01280100, +0x00200010,0x00200110,0x00280010,0x00280110, +0x01200010,0x01200110,0x01280010,0x01280110, +0x00000200,0x00000300,0x00080200,0x00080300, +0x01000200,0x01000300,0x01080200,0x01080300, +0x00000210,0x00000310,0x00080210,0x00080310, +0x01000210,0x01000310,0x01080210,0x01080310, +0x00200200,0x00200300,0x00280200,0x00280300, +0x01200200,0x01200300,0x01280200,0x01280300, +0x00200210,0x00200310,0x00280210,0x00280310, +0x01200210,0x01200310,0x01280210,0x01280310, +/* for D bits (numbered as per FIPS 46) 22 23 24 25 27 28 */ +0x00000000,0x04000000,0x00040000,0x04040000, +0x00000002,0x04000002,0x00040002,0x04040002, +0x00002000,0x04002000,0x00042000,0x04042000, +0x00002002,0x04002002,0x00042002,0x04042002, +0x00000020,0x04000020,0x00040020,0x04040020, +0x00000022,0x04000022,0x00040022,0x04040022, +0x00002020,0x04002020,0x00042020,0x04042020, +0x00002022,0x04002022,0x00042022,0x04042022, +0x00000800,0x04000800,0x00040800,0x04040800, +0x00000802,0x04000802,0x00040802,0x04040802, +0x00002800,0x04002800,0x00042800,0x04042800, +0x00002802,0x04002802,0x00042802,0x04042802, +0x00000820,0x04000820,0x00040820,0x04040820, +0x00000822,0x04000822,0x00040822,0x04040822, +0x00002820,0x04002820,0x00042820,0x04042820, +0x00002822,0x04002822,0x00042822,0x04042822, +}; + +/* See ecb_encrypt.c for a pseudo description of these macros. */ +#define PERM_OP(a,b,t,n,m) ((t)=((((a)>>(n))^(b))&(m)),\ + (b)^=(t),\ + (a)^=((t)<<(n))) + +#define HPERM_OP(a,t,n,m) ((t)=((((a)<<(16-(n)))^(a))&(m)),\ + (a)=(a)^(t)^(t>>(16-(n))))\ + +static char shifts2[16]={0,0,1,1,1,1,1,1,0,1,1,1,1,1,1,0}; + +static int body( + unsigned long *out0, + unsigned long *out1, + des_key_schedule ks, + unsigned long Eswap0, + unsigned long Eswap1); + +static int +des_set_key(des_cblock *key, des_key_schedule schedule) + { + register unsigned long c,d,t,s; + register unsigned char *in; + register unsigned long *k; + register int i; + + k=(unsigned long *)schedule; + in=(unsigned char *)key; + + c2l(in,c); + c2l(in,d); + + /* I now do it in 47 simple operations :-) + * Thanks to John Fletcher (john_fletcher@lccmail.ocf.llnl.gov) + * for the inspiration. :-) */ + PERM_OP (d,c,t,4,0x0f0f0f0f); + HPERM_OP(c,t,-2,0xcccc0000); + HPERM_OP(d,t,-2,0xcccc0000); + PERM_OP (d,c,t,1,0x55555555); + PERM_OP (c,d,t,8,0x00ff00ff); + PERM_OP (d,c,t,1,0x55555555); + d= (((d&0x000000ff)<<16)| (d&0x0000ff00) | + ((d&0x00ff0000)>>16)|((c&0xf0000000)>>4)); + c&=0x0fffffff; + + for (i=0; i>2)|(c<<26)); d=((d>>2)|(d<<26)); } + else + { c=((c>>1)|(c<<27)); d=((d>>1)|(d<<27)); } + c&=0x0fffffff; + d&=0x0fffffff; + /* could be a few less shifts but I am to lazy at this + * point in time to investigate */ + s= skb[0][ (c )&0x3f ]| + skb[1][((c>> 6)&0x03)|((c>> 7)&0x3c)]| + skb[2][((c>>13)&0x0f)|((c>>14)&0x30)]| + skb[3][((c>>20)&0x01)|((c>>21)&0x06) | + ((c>>22)&0x38)]; + t= skb[4][ (d )&0x3f ]| + skb[5][((d>> 7)&0x03)|((d>> 8)&0x3c)]| + skb[6][ (d>>15)&0x3f ]| + skb[7][((d>>21)&0x0f)|((d>>22)&0x30)]; + + /* table contained 0213 4657 */ + *(k++)=((t<<16)|(s&0x0000ffff))&0xffffffff; + s= ((s>>16)|(t&0xffff0000)); + + s=(s<<4)|(s>>28); + *(k++)=s&0xffffffff; + } + return(0); + } + +/****************************************************************** + * modified stuff for crypt. + ******************************************************************/ + +/* The changes to this macro may help or hinder, depending on the + * compiler and the achitecture. gcc2 always seems to do well :-). + * Inspired by Dana How + * DO NOT use the alternative version on machines with 8 byte longs. + */ +#ifdef ALT_ECB +#define D_ENCRYPT(L,R,S) \ + v=(R^(R>>16)); \ + u=(v&E0); \ + v=(v&E1); \ + u=((u^(u<<16))^R^s[S ])<<2; \ + t=(v^(v<<16))^R^s[S+1]; \ + t=(t>>2)|(t<<30); \ + L^= \ + *(unsigned long *)(des_SP+0x0100+((t )&0xfc))+ \ + *(unsigned long *)(des_SP+0x0300+((t>> 8)&0xfc))+ \ + *(unsigned long *)(des_SP+0x0500+((t>>16)&0xfc))+ \ + *(unsigned long *)(des_SP+0x0700+((t>>24)&0xfc))+ \ + *(unsigned long *)(des_SP+ ((u )&0xfc))+ \ + *(unsigned long *)(des_SP+0x0200+((u>> 8)&0xfc))+ \ + *(unsigned long *)(des_SP+0x0400+((u>>16)&0xfc))+ \ + *(unsigned long *)(des_SP+0x0600+((u>>24)&0xfc)); +#else /* original version */ +#define D_ENCRYPT(L,R,S) \ + v=(R^(R>>16)); \ + u=(v&E0); \ + v=(v&E1); \ + u=(u^(u<<16))^R^s[S ]; \ + t=(v^(v<<16))^R^s[S+1]; \ + t=(t>>4)|(t<<28); \ + L^= SPtrans[1][(t )&0x3f]| \ + SPtrans[3][(t>> 8)&0x3f]| \ + SPtrans[5][(t>>16)&0x3f]| \ + SPtrans[7][(t>>24)&0x3f]| \ + SPtrans[0][(u )&0x3f]| \ + SPtrans[2][(u>> 8)&0x3f]| \ + SPtrans[4][(u>>16)&0x3f]| \ + SPtrans[6][(u>>24)&0x3f]; +#endif + +unsigned char con_salt[128]={ +0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, +0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, +0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, +0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, +0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, +0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x01, +0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09, +0x0A,0x0B,0x05,0x06,0x07,0x08,0x09,0x0A, +0x0B,0x0C,0x0D,0x0E,0x0F,0x10,0x11,0x12, +0x13,0x14,0x15,0x16,0x17,0x18,0x19,0x1A, +0x1B,0x1C,0x1D,0x1E,0x1F,0x20,0x21,0x22, +0x23,0x24,0x25,0x20,0x21,0x22,0x23,0x24, +0x25,0x26,0x27,0x28,0x29,0x2A,0x2B,0x2C, +0x2D,0x2E,0x2F,0x30,0x31,0x32,0x33,0x34, +0x35,0x36,0x37,0x38,0x39,0x3A,0x3B,0x3C, +0x3D,0x3E,0x3F,0x00,0x00,0x00,0x00,0x00, +}; + +unsigned char cov_2char[64]={ +0x2E,0x2F,0x30,0x31,0x32,0x33,0x34,0x35, +0x36,0x37,0x38,0x39,0x41,0x42,0x43,0x44, +0x45,0x46,0x47,0x48,0x49,0x4A,0x4B,0x4C, +0x4D,0x4E,0x4F,0x50,0x51,0x52,0x53,0x54, +0x55,0x56,0x57,0x58,0x59,0x5A,0x61,0x62, +0x63,0x64,0x65,0x66,0x67,0x68,0x69,0x6A, +0x6B,0x6C,0x6D,0x6E,0x6F,0x70,0x71,0x72, +0x73,0x74,0x75,0x76,0x77,0x78,0x79,0x7A +}; + +char * +des_fcrypt(const char *buf, const char *salt, char *buff) + { + unsigned int i,j,x,y; + unsigned long Eswap0=0,Eswap1=0; + unsigned long out[2],ll; + des_cblock key; + des_key_schedule ks; + unsigned char bb[9]; + unsigned char *b=bb; + unsigned char c,u; + + /* eay 25/08/92 + * If you call crypt("pwd","*") as often happens when you + * have * as the pwd field in /etc/passwd, the function + * returns *\0XXXXXXXXX + * The \0 makes the string look like * so the pwd "*" would + * crypt to "*". This was found when replacing the crypt in + * our shared libraries. People found that the disbled + * accounts effectivly had no passwd :-(. */ + x=buff[0]=((salt[0] == '\0')?'A':salt[0]); + Eswap0=con_salt[x]; + x=buff[1]=((salt[1] == '\0')?'A':salt[1]); + Eswap1=con_salt[x]<<4; + + for (i=0; i<8; i++) + { + c= *(buf++); + if (!c) break; + key[i]=(c<<1); + } + for (; i<8; i++) + key[i]=0; + + des_set_key((des_cblock *)(key),ks); + body(&out[0],&out[1],ks,Eswap0,Eswap1); + + ll=out[0]; l2c(ll,b); + ll=out[1]; l2c(ll,b); + y=0; + u=0x80; + bb[8]=0; + for (i=2; i<13; i++) + { + c=0; + for (j=0; j<6; j++) + { + c<<=1; + if (bb[y] & u) c|=1; + u>>=1; + if (!u) + { + y++; + u=0x80; + } + } + buff[i]=cov_2char[c]; + } + buff[13]='\0'; + return buff; + } + +static int +body( unsigned long *out0, + unsigned long *out1, + des_key_schedule ks, + unsigned long Eswap0, + unsigned long Eswap1) + { + register unsigned long l,r,t,u,v; +#ifdef ALT_ECB + register unsigned char *des_SP=(unsigned char *)SPtrans; +#endif + register unsigned long *s; + register int i,j; + register unsigned long E0,E1; + + l=0; + r=0; + + s=(unsigned long *)ks; + E0=Eswap0; + E1=Eswap1; + + for (j=0; j<25; j++) + { + for (i=0; i<(ITERATIONS*2); i+=4) + { + D_ENCRYPT(l,r, i); /* 1 */ + D_ENCRYPT(r,l, i+2); /* 2 */ + } + t=l; + l=r; + r=t; + } + t=r; + r=(l>>1)|(l<<31); + l=(t>>1)|(t<<31); + /* clear the top bits on machines with 8byte longs */ + l&=0xffffffff; + r&=0xffffffff; + + PERM_OP(r,l,t, 1,0x55555555); + PERM_OP(l,r,t, 8,0x00ff00ff); + PERM_OP(r,l,t, 2,0x33333333); + PERM_OP(l,r,t,16,0x0000ffff); + PERM_OP(r,l,t, 4,0x0f0f0f0f); + + *out0=l; + *out1=r; + return(0); + } + diff -ruN perl-5.6.1/win32/makefile.mk AP629_source/win32/makefile.mk --- perl-5.6.1/win32/makefile.mk Wed May 2 00:08:14 2001 +++ AP629_source/win32/makefile.mk Thu Aug 23 17:30:28 2001 @@ -21,8 +21,8 @@ # Set these to wherever you want "dmake install" to put your newly # built perl. Setting it to a path with spaces is NOT recommended. # -INST_DRV *= c: -INST_TOP *= $(INST_DRV)\perl +INST_DRV *= p: +INST_TOP *= $(INST_DRV)\Apps\temp # # uncomment exactly one of the following @@ -32,11 +32,11 @@ # Visual C++ > 2.x and < 5.x SP3 #CCTYPE *= MSVC_PRE_50SP3 # Visual C++ >= 5.x SP3 -#CCTYPE *= MSVC60 +CCTYPE *= MSVC60 # Borland 5.02 or later #CCTYPE *= BORLAND # mingw32+gcc-2.95.2 or better -CCTYPE *= GCC +#CCTYPE *= GCC # # uncomment this if your Borland compiler is older than v5.4. @@ -56,8 +56,8 @@ # the path name should not be quoted. # #CCHOME *= F:\Borland\BC5 -#CCHOME *= $(MSVCDIR) -CCHOME *= c:\gcc-2.95.2-msvcrt +CCHOME *= $(MSVCDIR) +#CCHOME *= c:\gcc-2.95.2-msvcrt CCINCDIR *= $(CCHOME)\include CCLIBDIR *= $(CCHOME)\lib @@ -79,7 +79,7 @@ # If you don't enable one of these, the crypt() builtin will fail to work. # (Generally not critical.) # -#CRYPT_SRC *= fcrypt.c +CRYPT_SRC *= fcrypt.c #CRYPT_LIB *= fcrypt.lib # @@ -93,7 +93,7 @@ # the ActivePerl configuration will get you fork() emulation at the # cost of some added bloat. # -#BUILD_FLAVOR *= ActivePerl +BUILD_FLAVOR *= ActivePerl # # uncomment next line if you want debug version of perl (big and slow). @@ -236,7 +236,7 @@ # set this to your email address (perl will guess a value from # from your loginname and your hostname, which may not be right) # -#EMAIL *= +EMAIL *= support@ActiveState.com ## ## Build configuration ends. @@ -478,8 +478,8 @@ LIBC = PerlCRT.lib .ENDIF -PERLEXE_RES = -PERLDLL_RES = +PERLEXE_RES = perlexe.res +PERLDLL_RES = perldll.res .IF "$(CFG)" == "Debug" .IF "$(CCTYPE)" == "MSVC20" Binary files perl-5.6.1/win32/perldll.ico and AP629_source/win32/perldll.ico differ diff -ruN perl-5.6.1/win32/perldll.rc AP629_source/win32/perldll.rc --- perl-5.6.1/win32/perldll.rc Wed Dec 31 16:00:00 1969 +++ AP629_source/win32/perldll.rc Thu Aug 23 17:30:28 2001 @@ -0,0 +1,52 @@ +// PerlDll.rc + +// (c) 1995-1998 Microsoft Corporation. All rights reserved. +// Developed by ActiveState Tool Corp., http://www.ActiveState.com + +// You may distribute under the terms of either the GNU General Public +// License or the Artistic License, as specified in the README file. + +#include +#include "BuildInfo.h" + +PERLDLL ICON PerlDll.ico + +#ifndef _DEBUG +#define VER_DEBUG 0 +#else +#define VER_DEBUG VS_FF_DEBUG +#endif + +VS_VERSION_INFO VERSIONINFO + FILEVERSION PERLRC_VERSION + PRODUCTVERSION PERLRC_VERSION + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK + FILEFLAGS VER_DEBUG + FILEOS VOS_NT_WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE VFT2_UNKNOWN + +BEGIN +BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "ActiveState Tool Corp.\0", + VALUE "FileDescription", "Perl Interpreter\0", + VALUE "FileVersion", PERLFILEVERSION, + VALUE "InternalName", "Perl56.dll\0", + VALUE "LegalCopyright", "Copyright 1987-2001, Larry Wall, Binary build by ActiveState Tool Corp., http://www.ActiveState.com\0", + VALUE "LegalTrademarks", "\0", + VALUE "OriginalFilename", "Perl56.dll\0", + VALUE "ProductName", "ActivePerl\0", + VALUE "ProductVersion", PERLPRODUCTVERSION, + END + END + + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x409, 0x04E4 + // English language (0x409) and the Windows ANSI codepage (0x04E4) + END +END + Binary files perl-5.6.1/win32/perlexe.ico and AP629_source/win32/perlexe.ico differ diff -ruN perl-5.6.1/win32/perlexe.rc AP629_source/win32/perlexe.rc --- perl-5.6.1/win32/perlexe.rc Wed Dec 31 16:00:00 1969 +++ AP629_source/win32/perlexe.rc Thu Aug 23 17:30:28 2001 @@ -0,0 +1,52 @@ +// PerlExe.rc + +// (c) 1995-1999 Microsoft Corporation. All rights reserved. +// Developed by ActiveState Tool Corp., http://www.ActiveState.com + +// You may distribute under the terms of either the GNU General Public +// License or the Artistic License, as specified in the README file. + +#include +#include "BuildInfo.h" + +PERLEXE ICON PerlExe.ico + +#ifndef _DEBUG +#define VER_DEBUG 0 +#else +#define VER_DEBUG VS_FF_DEBUG +#endif + +VS_VERSION_INFO VERSIONINFO + FILEVERSION PERLRC_VERSION + PRODUCTVERSION PERLRC_VERSION + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK + FILEFLAGS VER_DEBUG + FILEOS VOS_NT_WINDOWS32 + FILETYPE VFT_APP + FILESUBTYPE VFT2_UNKNOWN + +BEGIN +BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "ActiveState Tool Corp.\0", + VALUE "FileDescription", "Perl Command Line Interpreter\0", + VALUE "FileVersion", PERLFILEVERSION, + VALUE "InternalName", "Perl.exe\0", + VALUE "LegalCopyright", "Copyright 1987-2001, Larry Wall, Binary build by ActiveState Tool Corp., http://www.ActiveState.com\0", + VALUE "LegalTrademarks", "\0", + VALUE "OriginalFilename", "Perl.exe\0", + VALUE "ProductName", "ActivePerl\0", + VALUE "ProductVersion", PERLPRODUCTVERSION, + END + END + + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x409, 0x04E4 + // English language (0x409) and the Windows ANSI codepage (0x04E4) + END +END + diff -ruN perl-5.6.1/win32/perlhost.h AP629_source/win32/perlhost.h --- perl-5.6.1/win32/perlhost.h Sun Mar 18 23:37:36 2001 +++ AP629_source/win32/perlhost.h Thu Aug 23 17:30:28 2001 @@ -2286,9 +2286,10 @@ void CPerlHost::Clearenv(void) { + dTHXo; char ch; LPSTR lpPtr, lpStr, lpEnvPtr; - if(m_lppEnvList != NULL) { + if (m_lppEnvList != NULL) { /* set every entry to an empty string */ for(DWORD index = 0; index < m_dwEnvCount; ++index) { char* ptr = strchr(m_lppEnvList[index], '='); @@ -2311,6 +2312,8 @@ ch = *++lpPtr; *lpPtr = 0; Add(lpStr); + if (!w32_pseudo_id) + (void)win32_putenv(lpStr); *lpPtr = ch; } lpStr += strlen(lpStr) + 1; @@ -2323,22 +2326,23 @@ char* CPerlHost::Getenv(const char *varname) { - char* pEnv = Find(varname); - if(pEnv == NULL) { - pEnv = win32_getenv(varname); + dTHXo; + if (w32_pseudo_id) { + char *pEnv = Find(varname); + if (pEnv && *pEnv) + return pEnv; } - else { - if(!*pEnv) - pEnv = 0; - } - - return pEnv; + return win32_getenv(varname); } int CPerlHost::Putenv(const char *envstring) { + dTHXo; Add(envstring); + if (!w32_pseudo_id) + return win32_putenv(envstring); + return 0; } diff -ruN perl-5.6.1/win32/win32.c AP629_source/win32/win32.c --- perl-5.6.1/win32/win32.c Sat Mar 3 11:53:20 2001 +++ AP629_source/win32/win32.c Thu Aug 23 17:30:28 2001 @@ -518,7 +518,7 @@ */ const char* defaultshell = (IsWinNT() ? "cmd.exe /x/c" : "command.com /c"); - const char *usershell = getenv("PERL5SHELL"); + const char *usershell = PerlEnv_getenv("PERL5SHELL"); w32_perlshell_items = tokenize(usershell ? usershell : defaultshell, &w32_perlshell_tokens, &w32_perlshell_vec); @@ -3055,7 +3055,7 @@ } /* look in PATH */ - pathstr = win32_getenv("PATH"); + pathstr = PerlEnv_getenv("PATH"); New(0, fullcmd, MAX_PATH+1, char); curfullcmd = fullcmd; @@ -3321,8 +3321,15 @@ dTHXo; /* if this is a pseudo-forked child, we just want to spawn * the new program, and return */ - if (w32_pseudo_id) - return win32_spawnvp(P_WAIT, cmdname, (char *const *)argv); + if (w32_pseudo_id) { + int status = win32_spawnvp(P_WAIT, cmdname, (char *const *)argv); + if (status != -1) { + my_exit(status); + return 0; + } + else + return status; + } #endif return execvp(cmdname, (char *const *)argv); } @@ -3559,6 +3566,13 @@ */ static +XS(w32_BuildNumber) +{ + dXSARGS; + XSRETURN_PV(PRODUCT_BUILD_NUMBER); +} + +static XS(w32_GetCwd) { dXSARGS; @@ -3831,6 +3845,8 @@ { dXSARGS; char *cmd, *args; + void *env; + char *dir; PROCESS_INFORMATION stProcInfo; STARTUPINFO stStartInfo; BOOL bSuccess = FALSE; @@ -3841,6 +3857,9 @@ cmd = SvPV_nolen(ST(0)); args = SvPV_nolen(ST(1)); + env = PerlEnv_get_childenv(); + dir = PerlEnv_get_childdir(); + memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */ stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */ stStartInfo.dwFlags = STARTF_USESHOWWINDOW; /* Enable wShowWindow control */ @@ -3853,8 +3872,8 @@ NULL, /* Default thread security */ FALSE, /* Must be TRUE to use std handles */ NORMAL_PRIORITY_CLASS, /* No special scheduling */ - NULL, /* Inherit our environment block */ - NULL, /* Inherit our currrent directory */ + env, /* Inherit our environment block */ + dir, /* Inherit our currrent directory */ &stStartInfo, /* -> Startup info */ &stProcInfo)) /* <- Process info (if OK) */ { @@ -3865,6 +3884,8 @@ CloseHandle(stProcInfo.hThread);/* library source code does this. */ bSuccess = TRUE; } + PerlEnv_free_childenv(env); + PerlEnv_free_childdir(dir); XSRETURN_IV(bSuccess); } @@ -4033,6 +4054,7 @@ newXS("Win32::GetLongPathName", w32_GetLongPathName, file); newXS("Win32::CopyFile", w32_CopyFile, file); newXS("Win32::Sleep", w32_Sleep, file); + newXS("Win32::BuildNumber", w32_BuildNumber, file); /* XXX Bloat Alert! The following Activeware preloads really * ought to be part of Win32::Sys::*, so they're not included diff -ruN perl-5.6.1/win32/win32.h AP629_source/win32/win32.h --- perl-5.6.1/win32/win32.h Sun Apr 1 01:00:23 2001 +++ AP629_source/win32/win32.h Thu Aug 23 17:30:28 2001 @@ -9,6 +9,8 @@ #ifndef _INC_WIN32_PERL5 #define _INC_WIN32_PERL5 +#include "BuildInfo.h" + #ifndef _WIN32_WINNT # define _WIN32_WINNT 0x0400 /* needed for TryEnterCriticalSection() etc. */ #endif diff -ruN perl-5.6.1/win32/win32thread.h AP629_source/win32/win32thread.h --- perl-5.6.1/win32/win32thread.h Thu Feb 22 18:58:00 2001 +++ AP629_source/win32/win32thread.h Thu Aug 23 17:30:28 2001 @@ -180,6 +180,8 @@ TlsFree(PL_thr_key); \ } STMT_END +#define PTHREAD_ATFORK(prepare,parent,child) NOOP + #if defined(USE_RTL_THREAD_API) && !defined(_MSC_VER) #define JOIN(t, avp) \ STMT_START { \ End of Patch. Detailed change log entries follow. ____________________________________________________________________________ [ 11708] By: sky on 2001/08/17 13:34:04 Log: Let perl_clone copy PL_exit_flags Branch: perl ! sv.c ____________________________________________________________________________ [ 11693] By: gsar on 2001/08/17 01:07:21 Log: change#10334 leaks memory, copies string when it doesn't need to Branch: perl ! perl.c ____________________________________________________________________________ [ 11562] By: jhi on 2001/08/03 12:11:57 Log: Subject: [patch] plug PL_cshname leak From: Doug MacEachern Date: Thu, 2 Aug 2001 20:59:04 -0700 (PDT) Message-ID: Branch: perl ! sv.c ____________________________________________________________________________ [ 11561] By: jhi on 2001/08/03 12:10:32 Log: Subject: [patch] plug PL_sh_path leak From: Doug MacEachern Date: Thu, 2 Aug 2001 20:54:08 -0700 (PDT) Message-ID: Branch: perl ! sv.c ____________________________________________________________________________ [ 11553] By: jhi on 2001/08/02 16:37:32 Log: Subject: [patch] ithreads + refto fix improvement From: Doug MacEachern Date: Thu, 2 Aug 2001 09:41:53 -0700 (PDT) Message-ID: Branch: perl ! pp.c ____________________________________________________________________________ [ 11539] By: jhi on 2001/08/01 16:32:52 Log: Test for change #11536. Branch: perl ! t/op/tiehandle.t ____________________________________________________________________________ [ 11536] By: jhi on 2001/08/01 16:08:08 Log: Subject: [patch] ithreads + refto bug From: Doug MacEachern Date: Wed, 1 Aug 2001 09:47:28 -0700 (PDT) Message-ID: (Test in change #11539) Branch: perl ! pp.c ____________________________________________________________________________ [ 11401] By: gsar on 2001/07/17 21:31:31 Log: thinko in change#11400 (duh) Branch: maint-5.6/perl ! win32/perlhost.h ____________________________________________________________________________ [ 11400] By: gsar on 2001/07/17 19:46:34 Log: change#11399 revealed another unrelated bug; this is just a temporary bandaid Branch: maint-5.6/perl ! win32/perlhost.h ____________________________________________________________________________ [ 11399] By: gsar on 2001/07/17 19:11:57 Log: fix bugs in handling of the virtualized environment under windows; there were bugs in propagating any changes to %ENV down to the real environment when such changes happened in the toplevel process (thanks to Johan Holmberg for the excellent problem identification, and for a part of the fix) Branch: maint-5.6/perl ! win32/perlhost.h win32/win32.c ____________________________________________________________________________ [ 11374] By: gsar on 2001/07/16 02:10:51 Log: make h2ph grok ccsymbols fo the form 1234L, 1234ULL etc. Branch: maint-5.6/perl ! utils/h2ph.PL ____________________________________________________________________________ [ 11329] By: jhi on 2001/07/12 22:54:39 Log: Subject: [PATCH 20010712.005] Re: Perl bug with "delete" on arrays From: Abhijit Menon-Sen Date: Fri, 13 Jul 2001 03:04:25 +0530 Message-ID: <20010713030425.A5669@lustre.dyn.wiw.org> Branch: perl ! av.c ____________________________________________________________________________ [ 11310] By: gsar on 2001/07/12 15:50:40 Log: fix for failing fork.t#12 on windows (win32_execvp() tweak in change#11300 needs to return the status of failed win32_spawnvp()) fix various open.pm bugs: '\0' isn't the same as "\0", so it wasn't splitting correctly; remove unused variables; 'require' at run time rather than 'use' at compile time for I18N::Langinfo, since it isn't everyware Branch: perl ! lib/open.pm win32/win32.c ____________________________________________________________________________ [ 11295] By: nick on 2001/07/12 11:11:44 Log: Honour void-ness of my_exit() Branch: perlio ! win32/win32.c ____________________________________________________________________________ [ 11282] By: jhi on 2001/07/12 00:35:27 Log: Subject: Re: ActivePerl 628 + warnings + fork + exec = spurious "Can't exec"? From: barries Date: Wed, 11 Jul 2001 15:11:46 -0400 Message-ID: <20010711151146.G24560@jester.slaysys.com> Branch: perl ! pp_sys.c t/lib/warnings/doio win32/win32.c ____________________________________________________________________________ [ 11152] By: gsar on 2001/07/05 00:52:57 Log: fix the binary compatibility issue when building with/without usemymalloc by exporting Perl_malloc() et al as simple wrappers around the system functions (this allows most extensions built using one mode to coexist with perls built in the other mode) XXX the Perl_mfree() wrapper might need to do return(free()) on platforms where Free_t isn't "void" Branch: perl ! embed.h embed.pl makedef.pl proto.h util.c ____________________________________________________________________________ [ 11151] By: gsar on 2001/07/05 00:42:49 Log: perl built with USE_ITHREADS can deadlock during fork() or backticks since it doesn't ensure threads other than the one calling fork() aren't holding any locks; the fix is to use pthread_atfork() to hold global locks building perl with -Dusemymalloc exacerbates the problem since Perl_malloc() holds a mutex, and perl's exec() calls New() XXX the code in win32thread.h may be needed on platforms that have no pthread_atfork() Branch: perl ! perl.c thread.h win32/win32thread.h ____________________________________________________________________________ [ 11087] By: jhi on 2001/07/02 13:23:21 Log: Subject: Re: Bug report: split splits on wrong pattern From: Abhijit Menon-Sen Message-ID: <20010702163133.A23186@lustre.dyn.wiw.org> Date: Mon, 2 Jul 2001 16:31:33 +0530 Branch: perl ! pp_ctl.c ____________________________________________________________________________ [ 11029] By: jhi on 2001/06/29 14:06:50 Log: Subject: Re: Bug report: split splits on wrong pattern From: Radu Greab Date: Wed, 27 Jun 2001 21:50:52 +0300 Message-ID: <15162.11020.279064.471031@ix.netsoft.ro> Branch: perl ! pp_ctl.c t/op/split.t ____________________________________________________________________________ [ 10754] By: gsar on 2001/06/20 15:22:27 Log: missing ld entry in Config.pm on Windows (makefile.mk had it, but not Makefile) Branch: maint-5.6/perl ! win32/Makefile ____________________________________________________________________________ [ 10739] By: gsar on 2001/06/19 23:49:15 Log: C fails to compile correctly Branch: maint-5.6/perl ! t/op/pat.t toke.c ____________________________________________________________________________ [ 10692] By: jhi on 2001/06/18 22:30:43 Log: Subject: PL_nullstash + perl_clone() From: Doug MacEachern Date: Mon, 18 Jun 2001 16:24:22 -0700 (PDT) Message-ID: Branch: perl ! sv.c ____________________________________________________________________________ [ 10667] By: gsar on 2001/06/17 19:08:27 Log: change#10449 broke the special-case that makes lexicals inside the eval"" within DB::DB() visible Branch: maint-5.6/perl ! op.c ____________________________________________________________________________ [ 10535] By: jhi on 2001/06/12 13:27:28 Log: As suggested in Subject: Re: ext/ + -Wall From: Gurusamy Sarathy Date: Mon, 11 Jun 2001 23:34:31 -0700 Message-Id: <200106120634.f5C6YVM07246@smtp3.ActiveState.com> Branch: perl ! ext/PerlIO/Scalar/Scalar.xs ext/PerlIO/Via/Via.xs globals.c ! perl.h ____________________________________________________________________________ [ 10532] By: jhi on 2001/06/12 12:37:36 Log: One more test for $^S. Branch: perl ! t/op/magic.t ____________________________________________________________________________ [ 10531] By: jhi on 2001/06/12 12:35:02 Log: Subject: [PATCH 20010612.002] $^S almost entirely broken with 5.6.1 From: Abhijit Menon-Sen Date: Tue, 12 Jun 2001 17:35:55 +0530 Message-ID: <20010612173555.A32426@lustre.linux.in> Branch: perl ! mg.c t/op/magic.t ____________________________________________________________________________ [ 10472] By: gsar on 2001/06/07 20:04:28 Log: integrate change#10471 from mainline in change#10451, check that CvOUTSIDE is a CV before looking in (it can apparently be SVt_NULL during global destruction) Branch: maint-5.6/perl !> op.c ____________________________________________________________________________ [ 10451] By: gsar on 2001/06/06 07:11:36 Log: change#9108 needs subtler treatment for case of closures created within eval"" Branch: maint-5.6/perl ! op.c t/op/misc.t ____________________________________________________________________________ [ 10450] By: gsar on 2001/06/06 05:47:25 Log: optimize change#10448 slightly (don't repeat search in eval""s lexical scope, since that has already been searched) Branch: maint-5.6/perl ! op.c ____________________________________________________________________________ [ 10448] By: gsar on 2001/06/06 01:03:26 Log: fix yet another bug of hoary vintage found by change#10394: lexicals outside an eval"" weren't resolved correctly inside a subroutine definition inside the eval"" if they were not already referenced in the toplevel of the eval""-ed code Branch: maint-5.6/perl ! cop.h op.c pp_ctl.c t/op/misc.t ____________________________________________________________________________ [ 10423] By: gsar on 2001/06/04 05:12:18 Log: testsuite for change#10192 (from Gisle Aas) Branch: perl + t/op/override.t ! MANIFEST ____________________________________________________________________________ [ 10422] By: gsar on 2001/06/04 02:32:03 Log: integrate changes#10414-10416 from mainline Potential buffer overrun if the radix separator is more than one byte. Also, under locales, prefer the locale-sp