SvREFCNT(&PL_sv_placeholder) = (~(U32)0)/2;
}
- PL_sighandlerp = Perl_sighandler;
+ PL_sighandlerp = (Sighandler_t) Perl_sighandler;
PL_pidstatus = newHV();
}
# endif
if ((long) PL_mmap_page_size < 0) {
if (errno) {
- SV *error = ERRSV;
+ SV * const error = ERRSV;
(void) SvUPGRADE(error, SVt_PV);
Perl_croak(aTHX_ "panic: sysconf: %s", SvPV_nolen_const(error));
}
if (CALL_FPTR(PL_threadhook)(aTHX)) {
/* Threads hook has vetoed further cleanup */
- return STATUS_NATIVE_EXPORT;
+ return STATUS_EXIT;
}
#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
*/
sv_clean_objs();
PL_sv_objcount = 0;
+ if (PL_defoutgv && !SvREFCNT(PL_defoutgv))
+ PL_defoutgv = Nullgv; /* may have been freed */
}
/* unhook hooks which will soon be, or use, destroyed data */
#endif
/* The exit() function will do everything that needs doing. */
- return STATUS_NATIVE_EXPORT;
+ return STATUS_EXIT;
}
/* jettison our possibly duplicated environment */
*/
I32 riter = 0;
const I32 max = HvMAX(PL_strtab);
- HE **array = HvARRAY(PL_strtab);
+ HE ** const array = HvARRAY(PL_strtab);
HE *hent = array[0];
for (;;) {
if (hent && ckWARN_d(WARN_INTERNAL)) {
- HE *next = HeNEXT(hent);
+ HE * const next = HeNEXT(hent);
Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
- "Unbalanced string table refcount: (%d) for \"%s\"",
- HeVAL(hent) - Nullsv, HeKEY(hent));
+ "Unbalanced string table refcount: (%ld) for \"%s\"",
+ (long)(HeVAL(hent) - Nullsv), HeKEY(hent));
Safefree(hent);
hent = next;
}
Safefree(PL_mess_sv);
PL_mess_sv = Nullsv;
}
- return STATUS_NATIVE_EXPORT;
+ return STATUS_EXIT;
}
/*
PL_curstash = PL_defstash;
if (PL_checkav)
call_list(oldscope, PL_checkav);
- ret = STATUS_NATIVE_EXPORT;
+ ret = STATUS_EXIT;
break;
case 3:
PerlIO_printf(Perl_error_log, "panic: top_env\n");
#endif
opts = SvCUR(opts_prog);
- sv_catpv(opts_prog,"\" Compile-time options:");
+ Perl_sv_catpv(aTHX_ opts_prog,"\" Compile-time options:"
# ifdef DEBUGGING
- sv_catpv(opts_prog," DEBUGGING");
+ " DEBUGGING"
# endif
# ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
- sv_catpv(opts_prog," DEBUG_LEAKING_SCALARS_FORK_DUMP");
+ " DEBUG_LEAKING_SCALARS_FORK_DUMP"
# endif
# ifdef FAKE_THREADS
- sv_catpv(opts_prog," FAKE_THREADS");
+ " FAKE_THREADS"
# endif
# ifdef MULTIPLICITY
- sv_catpv(opts_prog," MULTIPLICITY");
+ " MULTIPLICITY"
# endif
# ifdef MYMALLOC
- sv_catpv(opts_prog," MYMALLOC");
+ " MYMALLOC"
# endif
# ifdef PERL_DONT_CREATE_GVSV
- sv_catpv(opts_prog," PERL_DONT_CREATE_GVSV");
+ " PERL_DONT_CREATE_GVSV"
# endif
# ifdef PERL_GLOBAL_STRUCT
- sv_catpv(opts_prog," PERL_GLOBAL_STRUCT");
+ " PERL_GLOBAL_STRUCT"
# endif
# ifdef PERL_IMPLICIT_CONTEXT
- sv_catpv(opts_prog," PERL_IMPLICIT_CONTEXT");
+ " PERL_IMPLICIT_CONTEXT"
# endif
# ifdef PERL_IMPLICIT_SYS
- sv_catpv(opts_prog," PERL_IMPLICIT_SYS");
+ " PERL_IMPLICIT_SYS"
# endif
# ifdef PERL_MALLOC_WRAP
- sv_catpv(opts_prog," PERL_MALLOC_WRAP");
+ " PERL_MALLOC_WRAP"
# endif
# ifdef PERL_NEED_APPCTX
- sv_catpv(opts_prog," PERL_NEED_APPCTX");
+ " PERL_NEED_APPCTX"
# endif
# ifdef PERL_NEED_TIMESBASE
- sv_catpv(opts_prog," PERL_NEED_TIMESBASE");
+ " PERL_NEED_TIMESBASE"
# endif
# ifdef PERL_OLD_COPY_ON_WRITE
- sv_catpv(opts_prog," PERL_OLD_COPY_ON_WRITE");
+ " PERL_OLD_COPY_ON_WRITE"
+# endif
+# ifdef PERL_USE_SAFE_PUTENV
+ " PERL_USE_SAFE_PUTENV"
# endif
# ifdef PL_OP_SLAB_ALLOC
- sv_catpv(opts_prog," PL_OP_SLAB_ALLOC");
+ " PL_OP_SLAB_ALLOC"
# endif
# ifdef THREADS_HAVE_PIDS
- sv_catpv(opts_prog," THREADS_HAVE_PIDS");
+ " THREADS_HAVE_PIDS"
# endif
# ifdef USE_5005THREADS
- sv_catpv(opts_prog," USE_5005THREADS");
+ " USE_5005THREADS"
# endif
# ifdef USE_64_BIT_ALL
- sv_catpv(opts_prog," USE_64_BIT_ALL");
+ " USE_64_BIT_ALL"
# endif
# ifdef USE_64_BIT_INT
- sv_catpv(opts_prog," USE_64_BIT_INT");
+ " USE_64_BIT_INT"
# endif
# ifdef USE_ITHREADS
- sv_catpv(opts_prog," USE_ITHREADS");
+ " USE_ITHREADS"
# endif
# ifdef USE_LARGE_FILES
- sv_catpv(opts_prog," USE_LARGE_FILES");
+ " USE_LARGE_FILES"
# endif
# ifdef USE_LONG_DOUBLE
- sv_catpv(opts_prog," USE_LONG_DOUBLE");
+ " USE_LONG_DOUBLE"
# endif
# ifdef USE_PERLIO
- sv_catpv(opts_prog," USE_PERLIO");
+ " USE_PERLIO"
# endif
# ifdef USE_REENTRANT_API
- sv_catpv(opts_prog," USE_REENTRANT_API");
+ " USE_REENTRANT_API"
# endif
# ifdef USE_SFIO
- sv_catpv(opts_prog," USE_SFIO");
+ " USE_SFIO"
# endif
# ifdef USE_SITECUSTOMIZE
- sv_catpv(opts_prog," USE_SITECUSTOMIZE");
+ " USE_SITECUSTOMIZE"
# endif
# ifdef USE_SOCKS
- sv_catpv(opts_prog," USE_SOCKS");
+ " USE_SOCKS"
# endif
+ );
while (SvCUR(opts_prog) > opts+76) {
/* find last space after "options: " and before col 76
d = s;
if (!*s)
break;
- if (!strchr("DIMUdmtwA", *s))
+ if (!strchr("CDIMUdmtwA", *s))
Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s);
while (++s && *s) {
if (isSPACE(*s)) {
# define SIGCHLD SIGCLD
#endif
Sighandler_t sigstate = rsignal_state(SIGCHLD);
- if (sigstate == SIG_IGN) {
+ if (sigstate == (Sighandler_t) SIG_IGN) {
if (ckWARN(WARN_SIGNAL))
Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
"Can't ignore signal CHLD, forcing to default");
* or explicitly in some platforms.
* locale.c:Perl_init_i18nl10n() if the environment
* look like the user wants to use UTF-8. */
-#if defined(SYMBIAN)
+#if defined(__SYMBIAN32__)
PL_unicode = PERL_UNICODE_STD_FLAG; /* See PERL_SYMBIAN_CONSOLE_UTF8. */
#endif
if (PL_unicode) {
if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
dump_mstats("after execution: ");
#endif
- ret = STATUS_NATIVE_EXPORT;
+ ret = STATUS_EXIT;
break;
case 3:
if (PL_restartop) {
if (!PL_restartop) {
DEBUG_x(dump_all());
+#ifdef DEBUGGING
if (!DEBUG_q_TEST)
PERL_DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n"));
+#endif
DEBUG_S(PerlIO_printf(Perl_debug_log, "main thread is 0x%"UVxf"\n",
PTR2UV(thr)));
for (; isALNUM(**s); (*s)++) ;
}
else if (givehelp) {
- char **p = (char **)usage_msgd;
+ const char *const *p = usage_msgd;
while (*p) PerlIO_printf(PerlIO_stdout(), "%s\n", *p++);
}
# ifdef EBCDIC
PL_preambleav = newAV();
s++;
{
- char *start = s;
- SV *sv = newSVpv("use assertions::activate", 24);
+ char * const start = s;
+ SV * const sv = newSVpv("use assertions::activate", 24);
while(isALNUM(*s) || *s == ':') ++s;
if (s != start) {
sv_catpvn(sv, "::", 2);
s+=strlen(s);
}
else if (*s != '\0') {
- Perl_croak(aTHX_ "Can't use '%c' after -A%.*s", *s, s-start, start);
+ Perl_croak(aTHX_ "Can't use '%c' after -A%.*s", *s, (int)(s-start), start);
}
av_push(PL_preambleav, sv);
return s;
PerlIO_printf(PerlIO_stdout(),"Built on " __DATE__ " " __TIME__ "\n\n");
wce_hitreturn();
#endif
-#ifdef SYMBIAN
+#ifdef __SYMBIAN32__
PerlIO_printf(PerlIO_stdout(),
"Symbian port by Nokia, 2004-2005\n");
#endif
SvREFCNT_dec(GvHV(gv));
GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash);
SvREADONLY_on(gv);
- Perl_hv_name_set(aTHX_ PL_defstash, "main", 4, 0);
+ hv_name_set(PL_defstash, "main", 4, 0);
PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
GvMULTI_on(PL_incgv);
PL_hintgv = gv_fetchpv("\010",TRUE, SVt_PV); /* ^H */
#endif /* IAMSUID */
if (!PL_rsfp) {
/* PSz 16 Sep 03 Keep neat error message */
- Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
- CopFILE(PL_curcop), Strerror(errno));
+ if (PL_e_script)
+ Perl_croak(aTHX_ "Can't open "BIT_BUCKET": %s\n", Strerror(errno));
+ else
+ Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
+ CopFILE(PL_curcop), Strerror(errno));
}
}
if (!PL_tainting) {
#ifndef VMS
s = PerlEnv_getenv("PERL5LIB");
+/*
+ * It isn't possible to delete an environment variable with
+ * PERL_USE_SAFE_PUTENV set unless unsetenv() is also available, so in that
+ * case we treat PERL5LIB as undefined if it has a zero-length value.
+ */
+#if defined(PERL_USE_SAFE_PUTENV) && ! defined(HAS_UNSETENV)
+ if (s && *s != '\0')
+#else
if (s)
+#endif
incpush(s, TRUE, TRUE, TRUE, FALSE);
else
incpush(PerlEnv_getenv("PERLLIB"), FALSE, FALSE, TRUE, FALSE);
#endif /* MACOS_TRADITIONAL */
}
-#if defined(DOSISH) || defined(EPOC) || defined(SYMBIAN)
+#if defined(DOSISH) || defined(EPOC) || defined(__SYMBIAN32__)
# define PERLLIB_SEP ';'
#else
# if defined(VMS)
STATUS_ALL_FAILURE;
break;
default:
- STATUS_NATIVE_SET(status);
+ STATUS_UNIX_EXIT_SET(status);
break;
}
my_exit_jump();
projects / p5sagit/p5-mst-13.2.git / blobdiff