/* Init the real globals (and main thread)? */
if (!PL_linestr) {
+#ifdef USE_ITHREADS
+ MUTEX_INIT(&PL_dollarzero_mutex); /* for $0 modifying */
+#endif
#ifdef PERL_FLEXIBLE_EXCEPTIONS
PL_protect = MEMBER_TO_FPTR(Perl_default_protect); /* for exceptions */
#endif
*s = '\0';
SvCUR_set(PL_patchlevel, s - (U8*)SvPVX(PL_patchlevel));
SvPOK_on(PL_patchlevel);
- SvNVX(PL_patchlevel) = (NV)PERL_REVISION
- + ((NV)PERL_VERSION / (NV)1000)
-#if defined(PERL_SUBVERSION) && PERL_SUBVERSION > 0
- + ((NV)PERL_SUBVERSION / (NV)1000000)
-#endif
- ;
+ SvNVX(PL_patchlevel) = (NV)PERL_REVISION +
+ ((NV)PERL_VERSION / (NV)1000) +
+ ((NV)PERL_SUBVERSION / (NV)1000000);
SvNOK_on(PL_patchlevel); /* dual valued */
SvUTF8_on(PL_patchlevel);
SvREADONLY_on(PL_patchlevel);
/* Destroy the main CV and syntax tree */
if (PL_main_root) {
- PAD_UPDATE_CURPAD;
op_free(PL_main_root);
PL_main_root = Nullop;
}
PL_e_script = Nullsv;
}
- while (--PL_origargc >= 0) {
- Safefree(PL_origargv[PL_origargc]);
- }
- Safefree(PL_origargv);
-
/* magical thingies */
SvREFCNT_dec(PL_ofs_sv); /* $, */
if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Scalars leaked: %ld\n", (long)PL_sv_count);
+#ifdef DEBUG_LEAKING_SCALARS
+ if (PL_sv_count != 0) {
+ SV* sva;
+ SV* sv;
+ register SV* svend;
+
+ for (sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY(sva)) {
+ svend = &sva[SvREFCNT(sva)];
+ for (sv = sva + 1; sv < svend; ++sv) {
+ if (SvTYPE(sv) != SVTYPEMASK) {
+ PerlIO_printf(Perl_debug_log, "leaked: 0x%p\n", sv);
+ }
+ }
+ }
+ }
+#endif
+
+
#if defined(PERLIO_LAYERS)
/* No more IO - including error messages ! */
PerlIO_cleanup(aTHX);
#endif
PL_origargc = argc;
- {
- /* we copy rather than point to argv
- * since perl_clone will copy and perl_destruct
- * has no way of knowing if we've made a copy or
- * just point to argv
- */
- int i = PL_origargc;
- New(0, PL_origargv, i+1, char*);
- PL_origargv[i] = '\0';
- while (i-- > 0) {
- PL_origargv[i] = savepv(argv[i]);
- }
- }
-
-
+ PL_origargv = argv;
if (PL_do_undump) {
}
if (PL_main_root) {
- PAD_UPDATE_CURPAD;
op_free(PL_main_root);
PL_main_root = Nullop;
}
char *p;
STRLEN len = strlen(s);
p = savepvn(s, len);
- incpush(p, TRUE, TRUE);
+ incpush(p, TRUE, TRUE, FALSE);
sv_catpvn(sv, "-I", 2);
sv_catpvn(sv, p, len);
sv_catpvn(sv, " ", 1);
if (!PL_do_undump)
init_postdump_symbols(argc,argv,env);
- /* PL_wantutf8 is conditionally turned on by
+ /* PL_utf8locale is conditionally turned on by
* locale.c:Perl_init_i18nl10n() if the environment
- * look like the user wants to use UTF-8. */
- if (PL_wantutf8) { /* Requires init_predump_symbols(). */
+ * look like the user wants to use UTF-8.
+ * PL_wantutf8 is turned on by -C or by $ENV{PERL_UTF8_LOCALE}. */
+ if (PL_utf8locale && PL_wantutf8) { /* Requires init_predump_symbols(). */
IO* io;
PerlIO* fp;
SV* sv;
return s + numlen;
}
case 'C':
- PL_widesyscalls = TRUE;
+ PL_wantutf8 = TRUE; /* Can be set earlier by $ENV{PERL_UTF8_LOCALE}. */
s++;
+ if (*s == ':') {
+ PL_wantutf8 = (bool) atoi(s + 1);
+ for (s++; isDIGIT(*s); s++) ;
+ }
return s;
case 'F':
PL_minus_F = TRUE;
p++;
} while (*p && *p != '-');
e = savepvn(s, e-s);
- incpush(e, TRUE, TRUE);
+ incpush(e, TRUE, TRUE, FALSE);
Safefree(e);
s = p;
if (*s == '-')
for (; argc > 0; argc--,argv++) {
SV *sv = newSVpv(argv[0],0);
av_push(GvAVn(PL_argvgv),sv);
- if (PL_widesyscalls)
+ if (PL_wantutf8)
(void)sv_utf8_decode(sv);
}
}
#ifndef VMS
s = PerlEnv_getenv("PERL5LIB");
if (s)
- incpush(s, TRUE, TRUE);
+ incpush(s, TRUE, TRUE, TRUE);
else
- incpush(PerlEnv_getenv("PERLLIB"), FALSE, FALSE);
+ incpush(PerlEnv_getenv("PERLLIB"), FALSE, FALSE, TRUE);
#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,TRUE); } while (my_trnlnm("PERL5LIB",buf,++idx));
+ do { incpush(buf,TRUE,TRUE,TRUE); } while (my_trnlnm("PERL5LIB",buf,++idx));
else
- while (my_trnlnm("PERLLIB",buf,idx++)) incpush(buf,FALSE,FALSE);
+ while (my_trnlnm("PERLLIB",buf,idx++)) incpush(buf,FALSE,FALSE,TRUE);
#endif /* VMS */
}
ARCHLIB PRIVLIB SITEARCH SITELIB VENDORARCH and VENDORLIB
*/
#ifdef APPLLIB_EXP
- incpush(APPLLIB_EXP, TRUE, TRUE);
+ incpush(APPLLIB_EXP, TRUE, TRUE, TRUE);
#endif
#ifdef ARCHLIB_EXP
- incpush(ARCHLIB_EXP, FALSE, FALSE);
+ incpush(ARCHLIB_EXP, FALSE, FALSE, TRUE);
#endif
#ifdef MACOS_TRADITIONAL
{
Perl_sv_setpvf(aTHX_ privdir, "%slib:", macperl);
if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
- incpush(SvPVX(privdir), TRUE, FALSE);
+ incpush(SvPVX(privdir), TRUE, FALSE, TRUE);
Perl_sv_setpvf(aTHX_ privdir, "%ssite_perl:", macperl);
if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
- incpush(SvPVX(privdir), TRUE, FALSE);
+ incpush(SvPVX(privdir), TRUE, FALSE, TRUE);
SvREFCNT_dec(privdir);
}
if (!PL_tainting)
- incpush(":", FALSE, FALSE);
+ incpush(":", FALSE, FALSE, TRUE);
#else
#ifndef PRIVLIB_EXP
# define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
#endif
#if defined(WIN32)
- incpush(PRIVLIB_EXP, TRUE, FALSE);
+ incpush(PRIVLIB_EXP, TRUE, FALSE, TRUE);
#else
- incpush(PRIVLIB_EXP, FALSE, FALSE);
+ incpush(PRIVLIB_EXP, FALSE, FALSE, TRUE);
#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, FALSE);
+ incpush(SITEARCH_EXP, FALSE, FALSE, TRUE);
# endif
#endif
#ifdef SITELIB_EXP
# if defined(WIN32)
- incpush(SITELIB_EXP, TRUE, FALSE); /* this picks up sitearch as well */
+ /* this picks up sitearch as well */
+ incpush(SITELIB_EXP, TRUE, FALSE, TRUE);
# else
- incpush(SITELIB_EXP, FALSE, FALSE);
+ incpush(SITELIB_EXP, FALSE, FALSE, TRUE);
# endif
#endif
#ifdef SITELIB_STEM /* Search for version-specific dirs below here */
- incpush(SITELIB_STEM, FALSE, TRUE);
+ incpush(SITELIB_STEM, FALSE, TRUE, 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, FALSE);
+ incpush(PERL_VENDORARCH_EXP, FALSE, FALSE, TRUE);
# endif
#endif
#ifdef PERL_VENDORLIB_EXP
# if defined(WIN32)
- incpush(PERL_VENDORLIB_EXP, TRUE, FALSE); /* this picks up vendorarch as well */
+ incpush(PERL_VENDORLIB_EXP, TRUE, FALSE, TRUE); /* this picks up vendorarch as well */
# else
- incpush(PERL_VENDORLIB_EXP, FALSE, FALSE);
+ incpush(PERL_VENDORLIB_EXP, FALSE, FALSE, TRUE);
# endif
#endif
#ifdef PERL_VENDORLIB_STEM /* Search for version-specific dirs below here */
- incpush(PERL_VENDORLIB_STEM, FALSE, TRUE);
+ incpush(PERL_VENDORLIB_STEM, FALSE, TRUE, TRUE);
#endif
#ifdef PERL_OTHERLIBDIRS
- incpush(PERL_OTHERLIBDIRS, TRUE, TRUE);
+ incpush(PERL_OTHERLIBDIRS, TRUE, TRUE, TRUE);
#endif
if (!PL_tainting)
- incpush(".", FALSE, FALSE);
+ incpush(".", FALSE, FALSE, TRUE);
#endif /* MACOS_TRADITIONAL */
}
#endif
STATIC void
-S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers)
+S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers, int usesep)
{
SV *subdir = Nullsv;
char *s;
/* skip any consecutive separators */
- while ( *p == PERLLIB_SEP ) {
- /* Uncomment the next line for PATH semantics */
- /* av_push(GvAVn(PL_incgv), newSVpvn(".", 1)); */
- p++;
+ if (usesep) {
+ while ( *p == PERLLIB_SEP ) {
+ /* Uncomment the next line for PATH semantics */
+ /* av_push(GvAVn(PL_incgv), newSVpvn(".", 1)); */
+ p++;
+ }
}
- if ( (s = strchr(p, PERLLIB_SEP)) != Nullch ) {
+ if ( usesep && (s = strchr(p, PERLLIB_SEP)) != Nullch ) {
sv_setpvn(libdir, PERLLIB_MANGLE(p, (STRLEN)(s - p)),
(STRLEN)(s - p));
p = s + 1;
atsv = ERRSV;
(void)SvPV(atsv, len);
if (len) {
- STRLEN n_a;
PL_curcop = &PL_compiling;
CopLINE_set(PL_curcop, oldline);
if (paramList == PL_beginav)
while (PL_scopestack_ix > oldscope)
LEAVE;
JMPENV_POP;
- Perl_croak(aTHX_ "%s", SvPVx(atsv, n_a));
+ Perl_croak(aTHX_ "%"SVf"", atsv);
}
break;
case 1:
projects / p5sagit/p5-mst-13.2.git / blobdiff