#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 <unistd.h>
}
/*
+=for apidoc nothreadhook
+
+Stub that provides thread hook for perl_destruct when there are
+no threads.
+
+=cut
+*/
+
+int
+Perl_nothreadhook(pTHX)
+{
+ return 0;
+}
+
+/*
=for apidoc perl_destruct
Shuts down a Perl interpreter. See L<perlembed>.
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;;
+ }
+
/* We must account for everything. */
/* Destroy the main CV and syntax tree */
* 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++)
SvREFCNT_dec(PL_utf8_totitle);
SvREFCNT_dec(PL_utf8_tolower);
SvREFCNT_dec(PL_utf8_tofold);
+ SvREFCNT_dec(PL_utf8_idstart);
+ SvREFCNT_dec(PL_utf8_idcont);
PL_utf8_alnum = Nullsv;
PL_utf8_alnumc = Nullsv;
PL_utf8_ascii = Nullsv;
PL_utf8_totitle = Nullsv;
PL_utf8_tolower = Nullsv;
PL_utf8_tofold = Nullsv;
+ PL_utf8_idstart = Nullsv;
+ PL_utf8_idcont = Nullsv;
if (!specialWARN(PL_compiling.cop_warnings))
SvREFCNT_dec(PL_compiling.cop_warnings);
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++) {
+ SvREFCNT(PERL_DEBUG_PAD(i)) = 0;
+ sv_clear(PERL_DEBUG_PAD(i));
+ SvANY(PERL_DEBUG_PAD(i)) = NULL;
+ SvFLAGS(PERL_DEBUG_PAD(i)) = 0;
+ }
+ }
if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Scalars leaked: %ld\n", (long)PL_sv_count);
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)
# endif
PerlMem_free(aTHXx);
# ifdef NETWARE
- nw5_delete_internal_host(host);
+ nw_delete_internal_host(host);
# else
win32_delete_internal_host(host);
# endif
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;
{
GV *gv;
-
-
PL_curstash = PL_defstash = newHV();
PL_curstname = newSVpvn("main",4);
gv = gv_fetchpv("main::",TRUE, SVt_PVHV);
/* This strips off Perl comments which might interfere with
- the C pre-processor, including #!. #line directives are
- deliberately stripped to avoid confusion with Perl's version
+ the C pre-processor, including #!. #line directives are
+ deliberately stripped to avoid confusion with Perl's version
of #line. FWP played some golf with it so it will fit
into VMS's 255 character buffer.
*/
Perl_sv_setpvf(aTHX_ cmd, "\
%s -ne%s%s%s %s | %"SVf" %s %"SVf" %s",
- perl, quote, code, quote, scriptname, cpp,
+ perl, quote, code, quote, scriptname, cpp,
cpp_discard_flag, sv, CPPMINUS);
PL_doextract = FALSE;
}
# endif /* IAMSUID */
- DEBUG_P(PerlIO_printf(Perl_debug_log,
- "PL_preprocess: cmd=\"%s\"\n",
+ DEBUG_P(PerlIO_printf(Perl_debug_log,
+ "PL_preprocess: cmd=\"%s\"\n",
SvPVX(cmd)));
PL_rsfp = PerlProc_popen(SvPVX(cmd), "r");
PL_statbuf.st_mode & (S_ISUID|S_ISGID))
{
/* try again */
- PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT,
- BIN_EXP, (int)PERL_REVISION,
+ PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT,
+ BIN_EXP, (int)PERL_REVISION,
(int)PERL_VERSION,
(int)PERL_SUBVERSION), PL_origargv);
Perl_croak(aTHX_ "Can't do setuid\n");
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;
# 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)) {
* Then we just have to make sure he or she can execute it.
*/
{
- struct stat tmpstatbuf;
+ Stat_t tmpstatbuf;
if (
#ifdef HAS_SETREUID
*/
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,'=')))
sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
SvREADONLY_on(GvSV(tmpgv));
}
+
+ /* touch @F array to prevent spurious warnings 20020415 MJD */
+ if (PL_minus_a) {
+ (void) get_av("main::F", TRUE | GV_ADDMULTI);
+ }
+ /* touch @- and @+ arrays to prevent spurious warnings 20020415 MJD */
+ (void) get_av("main::-", TRUE | GV_ADDMULTI);
+ (void) get_av("main::+", TRUE | GV_ADDMULTI);
}
STATIC void
#endif
#ifdef MACOS_TRADITIONAL
{
- struct stat tmpstatbuf;
+ Stat_t tmpstatbuf;
SV * privdir = NEWSV(55, 0);
char * macperl = PerlEnv_getenv("MACPERL");
const char *incverlist[] = { PERL_INC_VERSION_LIST };
const char **incver;
#endif
- struct stat tmpstatbuf;
+ Stat_t tmpstatbuf;
#ifdef VMS
char *unix;
STRLEN len;
https://perl5.git.perl.org / perl5.git / blobdiff