X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=52301146c6cbb820985d278d07643de44af88f7d;hb=15e9f109c1a7f45bb9cf5e6903b016938a1441e8;hp=c32cc0a16eed4417064fe17a76c4607760ace58c;hpb=9f375a433613c9bc1f6215ee2370484d82068b54;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.c b/perl.c index c32cc0a..5230114 100644 --- a/perl.c +++ b/perl.c @@ -16,6 +16,11 @@ #include "perl.h" #include "patchlevel.h" /* for local_patches */ +#ifdef NETWARE +#include "nwutil.h" +char *nw_get_sitelib(const char *pl); +#endif + /* XXX If this causes problems, set i_unistd=undef in the hint file. */ #ifdef I_UNISTD #include @@ -425,6 +430,9 @@ perl_destruct(pTHXx) LEAVE; FREETMPS; + /* Need to flush since END blocks can produce output */ + PerlIO_flush((PerlIO*)NULL); + if (CALL_FPTR(PL_threadhook)(aTHX)) { /* Threads hook has vetoed further cleanup */ return STATUS_NATIVE_EXPORT;; @@ -490,7 +498,13 @@ perl_destruct(pTHXx) * so we certainly shouldn't free it here */ #if defined(USE_ENVIRON_ARRAY) && !defined(PERL_USE_SAFE_PUTENV) - if (environ != PL_origenviron) { + if (environ != PL_origenviron +#ifdef USE_ITHREADS + /* only main thread can free environ[0] contents */ + && PL_curinterp == aTHX +#endif + ) + { I32 i; for (i = 0; environ[i]; i++) @@ -817,9 +831,6 @@ perl_destruct(pTHXx) SvANY(&PL_sv_no) = NULL; SvFLAGS(&PL_sv_no) = 0; - SvREFCNT(&PL_sv_undef) = 0; - SvREADONLY_off(&PL_sv_undef); - { int i; for (i=0; i<=2; i++) { @@ -838,6 +849,13 @@ perl_destruct(pTHXx) PerlIO_cleanup(aTHX); #endif + /* sv_undef needs to stay immortal until after PerlIO_cleanup + as currently layers use it rather than Nullsv as a marker + for no arg - and will try and SvREFCNT_dec it. + */ + SvREFCNT(&PL_sv_undef) = 0; + SvREADONLY_off(&PL_sv_undef); + Safefree(PL_origfilename); Safefree(PL_reg_start_tmp); if (PL_reg_curpm) @@ -922,7 +940,7 @@ perl_free(pTHXx) # endif PerlMem_free(aTHXx); # ifdef NETWARE - nw5_delete_internal_host(host); + nw_delete_internal_host(host); # else win32_delete_internal_host(host); # endif @@ -2254,7 +2272,7 @@ Perl_moreswitches(pTHX_ char *s) else if (!rschar && numlen >= 2) PL_rs = newSVpvn("", 0); else { - char ch = rschar; + char ch = (char)rschar; PL_rs = newSVpvn(&ch, 1); } return s + numlen; @@ -2944,7 +2962,7 @@ S_fd_on_nosuid_fs(pTHX_ int fd) defined(HAS_STRUCT_FS_DATA) && \ defined(NOSTAT_ONE) # define FD_ON_NOSUID_CHECK_OKAY - struct stat fdst; + Stat_t fdst; if (fstat(fd, &fdst) == 0) { struct ustat us; @@ -2974,7 +2992,7 @@ S_fd_on_nosuid_fs(pTHX_ int fd) # define FD_ON_NOSUID_CHECK_OKAY FILE *mtab = fopen("/etc/mtab", "r"); struct mntent *entry; - struct stat stb, fsb; + Stat_t stb, fsb; if (mtab && (fstat(fd, &stb) == 0)) { while (entry = getmntent(mtab)) { @@ -3054,7 +3072,7 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript) * Then we just have to make sure he or she can execute it. */ { - struct stat tmpstatbuf; + Stat_t tmpstatbuf; if ( #ifdef HAS_SETREUID @@ -3564,8 +3582,14 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register */ if (!env) env = environ; - if (env != environ) + if (env != environ +# ifdef USE_ITHREADS + && PL_curinterp == aTHX +# endif + ) + { environ[0] = Nullch; + } if (env) for (; *env; env++) { if (!(s = strchr(*env,'='))) @@ -3635,7 +3659,7 @@ S_init_perllib(pTHX) #endif #ifdef MACOS_TRADITIONAL { - struct stat tmpstatbuf; + Stat_t tmpstatbuf; SV * privdir = NEWSV(55, 0); char * macperl = PerlEnv_getenv("MACPERL"); @@ -3779,7 +3803,7 @@ S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers) const char *incverlist[] = { PERL_INC_VERSION_LIST }; const char **incver; #endif - struct stat tmpstatbuf; + Stat_t tmpstatbuf; #ifdef VMS char *unix; STRLEN len;