PERL_SET_INTERP(my_perl); \
INIT_THREADS; \
ALLOC_THREAD_KEY; \
+ PERL_SET_THX(my_perl); \
+ OP_REFCNT_INIT; \
+ } \
+ else { \
+ PERL_SET_THX(my_perl); \
} \
- PERL_SET_THX(my_perl); \
} STMT_END
# else
# define INIT_TLS_AND_INTERP \
if (!specialWARN(PL_compiling.cop_warnings))
SvREFCNT_dec(PL_compiling.cop_warnings);
PL_compiling.cop_warnings = Nullsv;
+#ifndef USE_ITHREADS
+ SvREFCNT_dec(CopFILEGV(&PL_compiling));
+ CopFILEGV_set(&PL_compiling, Nullgv);
+#endif
/* Prepare to destruct main symbol table. */
SvREFCNT(&PL_sv_yes) = 0;
sv_clear(&PL_sv_yes);
SvANY(&PL_sv_yes) = NULL;
+ SvREADONLY_off(&PL_sv_yes);
SvREFCNT(&PL_sv_no) = 0;
sv_clear(&PL_sv_no);
SvANY(&PL_sv_no) = NULL;
+ SvREADONLY_off(&PL_sv_no);
+
+ SvREFCNT(&PL_sv_undef) = 0;
+ SvREADONLY_off(&PL_sv_undef);
if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
Perl_warner(aTHX_ WARN_INTERNAL,"Scalars leaked: %ld\n", (long)PL_sv_count);
#if defined(PERL_OBJECT)
PerlMem_free(this);
#else
+# if defined(PERL_IMPLICIT_SYS) && defined(WIN32)
+ void *host = w32_internal_host;
+ PerlMem_free(aTHXx);
+ win32_delete_internal_host(host);
+# else
PerlMem_free(aTHXx);
+# endif
#endif
}
char *p;
STRLEN len = strlen(s);
p = savepvn(s, len);
- incpush(p, TRUE);
+ incpush(p, TRUE, TRUE);
sv_catpvn(sv, "-I", 2);
sv_catpvn(sv, p, len);
sv_catpvn(sv, " ", 1);
SAVETMPS;
push_return(PL_op->op_next);
- PUSHBLOCK(cx, CXt_EVAL, PL_stack_sp);
+ PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
PUSHEVAL(cx, 0, 0);
PL_eval_root = PL_op; /* Only needed so that goto works right. */
p++;
} while (*p && *p != '-');
e = savepvn(s, e-s);
- incpush(e, TRUE);
+ incpush(e, TRUE, TRUE);
Safefree(e);
s = p;
if (*s == '-')
return s;
case 'W':
PL_dowarn = G_WARN_ALL_ON|G_WARN_ON;
- PL_compiling.cop_warnings = WARN_ALL ;
+ PL_compiling.cop_warnings = pWARN_ALL ;
s++;
return s;
case 'X':
PL_dowarn = G_WARN_ALL_OFF;
- PL_compiling.cop_warnings = WARN_NONE ;
+ PL_compiling.cop_warnings = pWARN_NONE ;
s++;
return s;
case '*':
#ifndef VMS
s = PerlEnv_getenv("PERL5LIB");
if (s)
- incpush(s, TRUE);
+ incpush(s, TRUE, TRUE);
else
- incpush(PerlEnv_getenv("PERLLIB"), FALSE);
+ incpush(PerlEnv_getenv("PERLLIB"), FALSE, FALSE);
#else /* VMS */
/* Treat PERL5?LIB as a possible search list logical name -- the
* "natural" VMS idiom for a Unix path string. We allow each
char buf[256];
int idx = 0;
if (my_trnlnm("PERL5LIB",buf,0))
- do { incpush(buf,TRUE); } while (my_trnlnm("PERL5LIB",buf,++idx));
+ do { incpush(buf,TRUE,TRUE); } while (my_trnlnm("PERL5LIB",buf,++idx));
else
- while (my_trnlnm("PERLLIB",buf,idx++)) incpush(buf,FALSE);
+ while (my_trnlnm("PERLLIB",buf,idx++)) incpush(buf,FALSE,FALSE);
#endif /* VMS */
}
ARCHLIB PRIVLIB SITEARCH SITELIB VENDORARCH and VENDORLIB
*/
#ifdef APPLLIB_EXP
- incpush(APPLLIB_EXP, TRUE);
+ incpush(APPLLIB_EXP, TRUE, TRUE);
#endif
#ifdef ARCHLIB_EXP
- incpush(ARCHLIB_EXP, FALSE);
+ incpush(ARCHLIB_EXP, FALSE, FALSE);
#endif
#ifndef PRIVLIB_EXP
# define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
#endif
#if defined(WIN32)
- incpush(PRIVLIB_EXP, TRUE);
+ incpush(PRIVLIB_EXP, TRUE, FALSE);
#else
- incpush(PRIVLIB_EXP, FALSE);
+ incpush(PRIVLIB_EXP, FALSE, FALSE);
#endif
#ifdef SITEARCH_EXP
/* sitearch is always relative to sitelib on Windows for
* DLL-based path intuition to work correctly */
# if !defined(WIN32)
- incpush(SITEARCH_EXP, FALSE);
+ incpush(SITEARCH_EXP, FALSE, FALSE);
# endif
#endif
#ifdef SITELIB_EXP
# if defined(WIN32)
- incpush(SITELIB_EXP, TRUE); /* this picks up sitearch as well */
+ incpush(SITELIB_EXP, TRUE, FALSE); /* this picks up sitearch as well */
# else
- incpush(SITELIB_EXP, FALSE);
+ incpush(SITELIB_EXP, FALSE, FALSE);
# endif
#endif
#ifdef SITELIB_STEM /* Search for version-specific dirs below here */
- incpush(SITELIB_STEM, TRUE);
+ incpush(SITELIB_STEM, FALSE, TRUE);
#endif
#ifdef PERL_VENDORARCH_EXP
/* vendorarch is always relative to vendorlib on Windows for
* DLL-based path intuition to work correctly */
# if !defined(WIN32)
- incpush(PERL_VENDORARCH_EXP, FALSE);
+ incpush(PERL_VENDORARCH_EXP, FALSE, FALSE);
# endif
#endif
#ifdef PERL_VENDORLIB_EXP
# if defined(WIN32)
- incpush(PERL_VENDORLIB_EXP, TRUE); /* this picks up vendorarch as well */
+ incpush(PERL_VENDORLIB_EXP, TRUE, FALSE); /* this picks up vendorarch as well */
# else
- incpush(PERL_VENDORLIB_EXP, FALSE);
+ incpush(PERL_VENDORLIB_EXP, FALSE, FALSE);
# endif
#endif
#ifdef PERL_VENDORLIB_STEM /* Search for version-specific dirs below here */
- incpush(PERL_VENDORLIB_STEM, TRUE);
+ incpush(PERL_VENDORLIB_STEM, FALSE, TRUE);
#endif
if (!PL_tainting)
- incpush(".", FALSE);
+ incpush(".", FALSE, FALSE);
}
#if defined(DOSISH)
#endif
STATIC void
-S_incpush(pTHX_ char *p, int addsubdirs)
+S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers)
{
SV *subdir = Nullsv;
if (!p || !*p)
return;
- if (addsubdirs) {
+ if (addsubdirs || addoldvers) {
subdir = sv_newmortal();
}
* BEFORE pushing libdir onto @INC we may first push version- and
* archname-specific sub-directories.
*/
- if (addsubdirs) {
+ if (addsubdirs || addoldvers) {
#ifdef PERL_INC_VERSION_LIST
/* Configure terminates PERL_INC_VERSION_LIST with a NULL */
const char *incverlist[] = { PERL_INC_VERSION_LIST };
"Failed to unixify @INC element \"%s\"\n",
SvPV(libdir,len));
#endif
- /* .../version/archname if -d .../version/archname */
- Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT"/%s", libdir,
- (int)PERL_REVISION, (int)PERL_VERSION,
- (int)PERL_SUBVERSION, ARCHNAME);
- if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
- S_ISDIR(tmpstatbuf.st_mode))
- av_push(GvAVn(PL_incgv), newSVsv(subdir));
-
- /* .../version if -d .../version */
- Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT, libdir,
- (int)PERL_REVISION, (int)PERL_VERSION,
- (int)PERL_SUBVERSION);
- if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
- S_ISDIR(tmpstatbuf.st_mode))
- av_push(GvAVn(PL_incgv), newSVsv(subdir));
-
- /* .../archname if -d .../archname */
- Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, ARCHNAME);
- if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
- S_ISDIR(tmpstatbuf.st_mode))
- av_push(GvAVn(PL_incgv), newSVsv(subdir));
+ if (addsubdirs) {
+ /* .../version/archname if -d .../version/archname */
+ Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT"/%s",
+ libdir,
+ (int)PERL_REVISION, (int)PERL_VERSION,
+ (int)PERL_SUBVERSION, ARCHNAME);
+ if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
+ S_ISDIR(tmpstatbuf.st_mode))
+ av_push(GvAVn(PL_incgv), newSVsv(subdir));
-#ifdef PERL_INC_VERSION_LIST
- for (incver = incverlist; *incver; incver++) {
- /* .../xxx if -d .../xxx */
- Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, *incver);
+ /* .../version if -d .../version */
+ Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT, libdir,
+ (int)PERL_REVISION, (int)PERL_VERSION,
+ (int)PERL_SUBVERSION);
+ if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
+ S_ISDIR(tmpstatbuf.st_mode))
+ av_push(GvAVn(PL_incgv), newSVsv(subdir));
+
+ /* .../archname if -d .../archname */
+ Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, ARCHNAME);
if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
S_ISDIR(tmpstatbuf.st_mode))
av_push(GvAVn(PL_incgv), newSVsv(subdir));
}
+
+#ifdef PERL_INC_VERSION_LIST
+ if (addoldvers) {
+ for (incver = incverlist; *incver; incver++) {
+ /* .../xxx if -d .../xxx */
+ Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, *incver);
+ if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
+ S_ISDIR(tmpstatbuf.st_mode))
+ av_push(GvAVn(PL_incgv), newSVsv(subdir));
+ }
+ }
#endif
}