#include <unistd.h>
#endif
+#if !defined(STANDARD_C) && !defined(HAS_GETENV_PROTOTYPE)
+char *getenv _((char *)); /* Usually in <stdlib.h> */
+#endif
+
dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n";
#ifdef IAMSUID
}
#endif
- /* unhook hooks which will soon be, or use, destroyed data */
- SvREFCNT_dec(warnhook);
- warnhook = Nullsv;
- SvREFCNT_dec(diehook);
- diehook = Nullsv;
- SvREFCNT_dec(parsehook);
- parsehook = Nullsv;
-
LEAVE;
FREETMPS;
sv_clean_objs();
}
+ /* unhook hooks which will soon be, or use, destroyed data */
+ SvREFCNT_dec(warnhook);
+ warnhook = Nullsv;
+ SvREFCNT_dec(diehook);
+ diehook = Nullsv;
+ SvREFCNT_dec(parsehook);
+ parsehook = Nullsv;
+
if (destruct_level == 0){
DEBUG_P(debprofdump());
return;
Safefree(sv_interp);
}
-#if !defined(STANDARD_C) && !defined(HAS_GETENV_PROTOTYPE)
-char *getenv _((char *)); /* Usually in <stdlib.h> */
-#endif
int
perl_parse(sv_interp, xsinit, argc, argv, env)
I32 oldscope;
AV* comppadlist;
dJMPENV;
+ int ret;
#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
#ifdef IAMSUID
time(&basetime);
oldscope = scopestack_ix;
- switch (JMPENV_PUSH) {
+ JMPENV_PUSH(ret);
+ switch (ret) {
case 1:
STATUS_ALL_FAILURE;
/* FALL THROUGH */
sv = newSVpv("",0); /* first used for -I flags */
SAVEFREESV(sv);
init_main_stash();
+
for (argc--,argv++; argc > 0; argc--,argv++) {
if (argv[0][0] != '-' || !argv[0][1])
break;
sv_catpv(Sv,buf);
#endif
#if defined(LOCAL_PATCH_COUNT)
- if (LOCAL_PATCH_COUNT > 0)
- { int i;
- sv_catpv(Sv,"print \" Locally applied patches:\\n\",");
+ if (LOCAL_PATCH_COUNT > 0) {
+ int i;
+ sv_catpv(Sv,"\" Locally applied patches:\\n\",");
for (i = 1; i <= LOCAL_PATCH_COUNT; i++) {
if (localpatches[i]) {
sprintf(buf,"\" \\t%s\\n\",",localpatches[i]);
}
}
#endif
- sprintf(buf,"\" Built under %s\\n\",",OSNAME);
+ sprintf(buf,"\" Built under %s\\n\"",OSNAME);
sv_catpv(Sv,buf);
#ifdef __DATE__
# ifdef __TIME__
- sprintf(buf,"\" Compiled at %s %s\\n\"",__DATE__,__TIME__);
+ sprintf(buf,",\" Compiled at %s %s\\n\"",__DATE__,__TIME__);
# else
- sprintf(buf,"\" Compiled on %s\\n\"",__DATE__);
+ sprintf(buf,",\" Compiled on %s\\n\"",__DATE__);
# endif
sv_catpv(Sv,buf);
#endif
- sv_catpv(Sv,"; $\"=\"\\n \"; print \" \\@INC:\\n @INC\\n\"");
+ sv_catpv(Sv, "; \
+$\"=\"\\n \"; \
+@env = map { \"$_=\\\"$ENV{$_}\\\"\" } sort grep {/^PERL/} keys %ENV; \
+print \" \\%ENV:\\n @env\\n\" if @env; \
+print \" \\@INC:\\n @INC\\n\";");
}
else {
Sv = newSVpv("config_vars(qw(",0);
}
}
switch_end:
+
+ if (!tainting && (s = getenv("PERL5OPT"))) {
+ for (;;) {
+ while (isSPACE(*s))
+ s++;
+ if (*s == '-') {
+ s++;
+ if (isSPACE(*s))
+ continue;
+ }
+ if (!*s)
+ break;
+ if (!strchr("DIMUdmw", *s))
+ croak("Illegal switch in PERL5OPT: -%c", *s);
+ s = moreswitches(s);
+ }
+ }
+
if (!scriptname)
scriptname = argv[0];
if (e_fp) {
perl_run(sv_interp)
PerlInterpreter *sv_interp;
{
- dJMPENV;
I32 oldscope;
+ dJMPENV;
+ int ret;
if (!(curinterp = sv_interp))
return 255;
oldscope = scopestack_ix;
- switch (JMPENV_PUSH) {
+ JMPENV_PUSH(ret);
+ switch (ret) {
case 1:
cxstack_ix = -1; /* start context stack again */
break;
static CV *DBcv;
bool oldcatch = CATCH_GET;
dJMPENV;
+ int ret;
if (flags & G_DISCARD) {
ENTER;
}
Zero(&myop, 1, LOGOP);
+ myop.op_next = Nullop;
if (!(flags & G_NOARGS))
myop.op_flags |= OPf_STACKED;
- myop.op_next = Nullop;
- myop.op_flags |= OPf_KNOW;
- if (flags & G_ARRAY)
- myop.op_flags |= OPf_LIST;
+ myop.op_flags |= ((flags & G_VOID) ? OPf_WANT_VOID :
+ (flags & G_ARRAY) ? OPf_WANT_LIST :
+ OPf_WANT_SCALAR);
SAVESPTR(op);
op = (OP*)&myop;
/* we're trying to emulate pp_entertry() here */
{
register CONTEXT *cx;
- I32 gimme = GIMME;
+ I32 gimme = GIMME_V;
ENTER;
SAVETMPS;
}
markstack_ptr++;
- switch (JMPENV_PUSH) {
+ JMPENV_PUSH(ret);
+ switch (ret) {
case 0:
break;
case 1:
I32 retval;
I32 oldscope;
dJMPENV;
+ int ret;
if (flags & G_DISCARD) {
ENTER;
myop.op_flags = OPf_STACKED;
myop.op_next = Nullop;
myop.op_type = OP_ENTEREVAL;
- myop.op_flags |= OPf_KNOW;
+ myop.op_flags |= ((flags & G_VOID) ? OPf_WANT_VOID :
+ (flags & G_ARRAY) ? OPf_WANT_LIST :
+ OPf_WANT_SCALAR);
if (flags & G_KEEPERR)
myop.op_flags |= OPf_SPECIAL;
- if (flags & G_ARRAY)
- myop.op_flags |= OPf_LIST;
- switch (JMPENV_PUSH) {
+ JMPENV_PUSH(ret);
+ switch (ret) {
case 0:
break;
case 1:
HV *hv;
GvMULTI_on(envgv);
hv = GvHVn(envgv);
- hv_clear(hv);
+ hv_magic(hv, envgv, 'E');
#ifndef VMS /* VMS doesn't have environ array */
/* Note that if the supplied env parameter is actually a copy
of the global environ then it may now point to free'd memory
*/
if (!env)
env = environ;
- if (env != environ) {
+ if (env != environ)
environ[0] = Nullch;
- hv_magic(hv, envgv, 'E');
- }
for (; *env; env++) {
if (!(s = strchr(*env,'=')))
continue;
*s++ = '\0';
sv = newSVpv(s--,0);
- sv_magic(sv, sv, 'e', *env, s - *env);
(void)hv_store(hv, *env, s - *env, sv, 0);
*s = '=';
}
#ifdef DYNAMIC_ENV_FETCH
HvNAME(hv) = savepv(ENV_HV_NAME);
#endif
- hv_magic(hv, envgv, 'E');
}
TAINT_NOT;
if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
I32 oldscope;
AV* list;
{
- dJMPENV;
- STRLEN len;
line_t oldline = curcop->cop_line;
+ STRLEN len;
+ dJMPENV;
+ int ret;
while (AvFILL(list) >= 0) {
CV *cv = (CV*)av_shift(list);
SAVEFREESV(cv);
- switch (JMPENV_PUSH) {
+ JMPENV_PUSH(ret);
+ switch (ret) {
case 0: {
SV* atsv = GvSV(errgv);
PUSHMARK(stack_sp);