perl_construct(pTHXx)
{
dVAR;
- PERL_UNUSED_CONTEXT;
+ PERL_UNUSED_ARG(my_perl);
#ifdef MULTIPLICITY
init_interp();
PL_perl_destruct_level = 1;
it to dump out to. We can't let it hold open the file descriptor when it
forks, as the file descriptor it will dump to can turn out to be one end
of pipe that some other process will wait on for EOF. (So as it would
- be open, the wait would be forever. */
+ be open, the wait would be forever.) */
msg.msg_control = control.control;
msg.msg_controllen = sizeof(control.control);
perl_destruct(pTHXx)
{
dVAR;
- volatile int destruct_level; /* 0=none, 1=full, 2=full with checks */
+ VOL int destruct_level; /* 0=none, 1=full, 2=full with checks */
HV *hv;
#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
pid_t child;
#endif
- PERL_UNUSED_CONTEXT;
+ PERL_UNUSED_ARG(my_perl);
/* wait for all pseudo-forked children to finish */
PERL_WAIT_FOR_CHILDREN;
PL_exitlist = NULL;
PL_exitlistlen = 0;
- if (destruct_level == 0){
-
- DEBUG_P(debprofdump());
-
-#if defined(PERLIO_LAYERS)
- /* No more IO - including error messages ! */
- PerlIO_cleanup(aTHX);
-#endif
-
- /* The exit() function will do everything that needs doing. */
- return STATUS_EXIT;
- }
-
/* jettison our possibly duplicated environment */
/* if PERL_USE_SAFE_PUTENV is defined environ will not have been copied
* so we certainly shouldn't free it here
#endif
#endif /* !PERL_MICRO */
+ if (destruct_level == 0) {
+
+ DEBUG_P(debprofdump());
+
+#if defined(PERLIO_LAYERS)
+ /* No more IO - including error messages ! */
+ PerlIO_cleanup(aTHX);
+#endif
+
+ CopFILE_free(&PL_compiling);
+ CopSTASH_free(&PL_compiling);
+
+ /* The exit() function will do everything that needs doing. */
+ return STATUS_EXIT;
+ }
+
/* reset so print() ends up where we expect */
setdefout(NULL);
SvREFCNT_dec(PL_rsfp_filters);
PL_rsfp_filters = NULL;
+ if (PL_minus_F) {
+ Safefree(PL_splitstr);
+ PL_splitstr = NULL;
+ }
+
/* switches */
PL_preprocess = FALSE;
PL_minus_n = FALSE;
SvREFCNT_dec(PL_endav);
SvREFCNT_dec(PL_checkav);
SvREFCNT_dec(PL_checkav_save);
+ SvREFCNT_dec(PL_unitcheckav);
+ SvREFCNT_dec(PL_unitcheckav_save);
SvREFCNT_dec(PL_initav);
PL_beginav = NULL;
PL_beginav_save = NULL;
PL_endav = NULL;
PL_checkav = NULL;
PL_checkav_save = NULL;
+ PL_unitcheckav = NULL;
+ PL_unitcheckav_save = NULL;
PL_initav = NULL;
/* shortcuts just get cleared */
int ret;
dJMPENV;
- PERL_UNUSED_VAR(my_perl);
+ PERL_UNUSED_ARG(my_perl);
#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
#ifdef IAMSUID
}
/* Can we grab env area too to be used as the area for $0? */
if (s && PL_origenviron) {
- if ((PL_origenviron[0] == s + 1
-#ifdef OS2
- || (PL_origenviron[0] == s + 9 && (s += 8))
-#endif
- )
+ if ((PL_origenviron[0] == s + 1)
||
(aligned &&
(PL_origenviron[0] > s &&
INT2PTR(char *, PTR2UV(s + PTRSIZE) & mask)))
)
{
-#ifndef OS2
+#ifndef OS2 /* ENVIRON is read by the kernel too. */
s = PL_origenviron[0];
while (*s) s++;
#endif
switch (ret) {
case 0:
parse_body(env,xsinit);
+ if (PL_unitcheckav)
+ call_list(oldscope, PL_unitcheckav);
if (PL_checkav)
call_list(oldscope, PL_checkav);
ret = 0;
LEAVE;
FREETMPS;
PL_curstash = PL_defstash;
+ if (PL_unitcheckav)
+ call_list(oldscope, PL_unitcheckav);
if (PL_checkav)
call_list(oldscope, PL_checkav);
ret = STATUS_EXIT;
VOL bool dosearch = FALSE;
const char *validarg = "";
register SV *sv;
- register char *s;
+ register char *s, c;
const char *cddir = NULL;
#ifdef USE_SITECUSTOMIZE
bool minus_f = FALSE;
#endif
s = argv[0]+1;
reswitch:
- switch (*s) {
+ switch ((c = *s)) {
case 'C':
#ifndef PERL_STRICT_CR
case '\r':
argc--,argv++;
}
else
- Perl_croak(aTHX_ "No code specified for -%c", *s);
+ Perl_croak(aTHX_ "No code specified for -%c", c);
sv_catpvs(PL_e_script, "\n");
break;
int ret = 0;
dJMPENV;
- PERL_UNUSED_CONTEXT;
+ PERL_UNUSED_ARG(my_perl);
oldscope = PL_scopestack_ix;
#ifdef VMS
LOGOP myop; /* fake syntax tree node */
UNOP method_op;
I32 oldmark;
- volatile I32 retval = 0;
+ VOL I32 retval = 0;
I32 oldscope;
bool oldcatch = CATCH_GET;
int ret;
dVAR;
dSP;
UNOP myop; /* fake syntax tree node */
- volatile I32 oldmark = SP - PL_stack_base;
- volatile I32 retval = 0;
+ VOL I32 oldmark = SP - PL_stack_base;
+ VOL I32 retval = 0;
int ret;
OP* const oldop = PL_op;
dJMPENV;
int i = 0;
if (isALPHA(**s)) {
/* if adding extra options, remember to update DEBUG_MASK */
- static const char debopts[] = "psltocPmfrxu HXDSTRJvCAq";
+ static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAq";
for (; isALNUM(**s); (*s)++) {
const char * const d = strchr(debopts,**s);
/* As these are inside a structure, PERLVARI isn't capable of initialising
them */
- PL_regindent = 0;
PL_reg_oldcurpm = PL_reg_curpm = NULL;
PL_reg_poscache = PL_reg_starttry = NULL;
}
}
if ((PL_envgv = gv_fetchpvs("ENV", GV_ADD|GV_NOTQUAL, SVt_PVHV))) {
HV *hv;
+ bool env_is_not_environ;
GvMULTI_on(PL_envgv);
hv = GvHVn(PL_envgv);
hv_magic(hv, NULL, PERL_MAGIC_env);
*/
if (!env)
env = environ;
- if (env != environ
+ env_is_not_environ = env != environ;
+ if (env_is_not_environ
# ifdef USE_ITHREADS
&& PL_curinterp == aTHX
# endif
#endif
sv = newSVpv(s+1, 0);
(void)hv_store(hv, *env, s - *env, sv, 0);
- if (env != environ)
+ if (env_is_not_environ)
mg_set(sv);
if (origenv != environ) {
/* realloc has shifted us */
if (addoldvers) {
for (incver = incverlist; *incver; incver++) {
/* .../xxx if -d .../xxx */
- Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT, libdir, *incver);
+ Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT, (void *)libdir, *incver);
subdir = S_incpush_if_exists(aTHX_ subdir);
}
}
PL_checkav_save = newAV();
av_push(PL_checkav_save, (SV*)cv);
}
+ else if (paramList == PL_unitcheckav) {
+ /* save PL_unitcheckav for compiler */
+ if (! PL_unitcheckav_save)
+ PL_unitcheckav_save = newAV();
+ av_push(PL_unitcheckav_save, (SV*)cv);
+ }
} else {
if (!PL_madskills)
SAVEFREESV(cv);
"%s failed--call queue aborted",
paramList == PL_checkav ? "CHECK"
: paramList == PL_initav ? "INIT"
+ : paramList == PL_unitcheckav ? "UNITCHECK"
: "END");
while (PL_scopestack_ix > oldscope)
LEAVE;
Perl_croak(aTHX_ "%s failed--call queue aborted",
paramList == PL_checkav ? "CHECK"
: paramList == PL_initav ? "INIT"
+ : paramList == PL_unitcheckav ? "UNITCHECK"
: "END");
}
my_exit_jump();