/* perl.c
*
- * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others
+ * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
+ * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
int f;
const char *where;
/* Our success message is an integer 0, and a char 0 */
- static const char success[sizeof(int) + 1];
+ static const char success[sizeof(int) + 1] = {0};
close(fd[0]);
}
/* Now absolutely destruct everything, somehow or other, loops or no. */
- SvFLAGS(PL_fdpid) |= SVTYPEMASK; /* don't clean out pid table now */
- SvFLAGS(PL_strtab) |= SVTYPEMASK; /* don't clean out strtab now */
/* the 2 is for PL_fdpid and PL_strtab */
- while (PL_sv_count > 2 && sv_clean_all())
+ while (sv_clean_all() > 2)
;
- SvFLAGS(PL_fdpid) &= ~SVTYPEMASK;
- SvFLAGS(PL_fdpid) |= SVt_PVAV;
- SvFLAGS(PL_strtab) &= ~SVTYPEMASK;
- SvFLAGS(PL_strtab) |= SVt_PVHV;
-
AvREAL_off(PL_fdpid); /* no surviving entries */
SvREFCNT_dec(PL_fdpid); /* needed in io_close() */
PL_fdpid = NULL;
# ifdef USE_SITECUSTOMIZE
" USE_SITECUSTOMIZE"
# endif
+# ifdef USE_FAST_STDIO
+ " USE_FAST_STDIO"
+# endif
, 0);
sv_catpv(opts_prog, PL_bincompat_options);
#endif
(s = PerlEnv_getenv("PERL5OPT")))
{
- const char *popt = s;
while (isSPACE(*s))
s++;
if (*s == '-' && *(s+1) == 'T') {
else {
char *popt_copy = NULL;
while (s && *s) {
- char *d;
+ const char *d;
while (isSPACE(*s))
s++;
if (*s == '-') {
while (++s && *s) {
if (isSPACE(*s)) {
if (!popt_copy) {
- popt_copy = SvPVX(sv_2mortal(newSVpv(popt,0)));
- s = popt_copy + (s - popt);
- d = popt_copy + (d - popt);
+ popt_copy = SvPVX(sv_2mortal(newSVpv(d,0)));
+ s = popt_copy + (s - d);
+ d = popt_copy;
}
*s++ = '\0';
break;
}
}
- PL_main_cv = PL_compcv = (CV*)newSV_type(SVt_PVCV);
+ PL_main_cv = PL_compcv = MUTABLE_CV(newSV_type(SVt_PVCV));
CvUNIQUE_on(PL_compcv);
CvPADLIST(PL_compcv) = pad_new(0);
&& (PL_DBcv || (PL_DBcv = GvCV(PL_DBsub)))
/* Try harder, since this may have been a sighandler, thus
* curstash may be meaningless. */
- && (SvTYPE(sv) != SVt_PVCV || CvSTASH((CV*)sv) != PL_debstash)
+ && (SvTYPE(sv) != SVt_PVCV || CvSTASH((const CV *)sv) != PL_debstash)
&& !(flags & G_NODEBUG))
PL_op->op_private |= OPpENTERSUB_DB;
redo_body:
CALL_BODY_SUB((OP*)&myop);
retval = PL_stack_sp - (PL_stack_base + oldmark);
- if (!(flags & G_KEEPERR))
- sv_setpvn(ERRSV,"",0);
+ if (!(flags & G_KEEPERR)) {
+ CLEAR_ERRSV();
+ }
break;
case 1:
STATUS_ALL_FAILURE;
redo_body:
CALL_BODY_EVAL((OP*)&myop);
retval = PL_stack_sp - (PL_stack_base + oldmark);
- if (!(flags & G_KEEPERR))
- sv_setpvn(ERRSV,"",0);
+ if (!(flags & G_KEEPERR)) {
+ CLEAR_ERRSV();
+ }
break;
case 1:
STATUS_ALL_FAILURE;
" o Method and overloading resolution",
" c String/numeric conversions",
" P Print profiling info, source file input state",
- " m Memory allocation",
+ " m Memory and SV allocation",
" f Format processing",
" r Regular expression parsing and execution",
" x Syntax tree dump",
if (colon)
Perl_croak(aTHX_ "Invalid module name %.*s with -%c option: "
"contains single ':'",
- s - start, start, option);
+ (int)(s - start), start, option);
end = s + strlen(s);
if (*s != '=') {
sv_catpvn(sv, start, end - start);
#endif
PerlIO_printf(PerlIO_stdout(),
- "\n\nCopyright 1987-2007, Larry Wall\n");
+ "\n\nCopyright 1987-2008, Larry Wall\n");
#ifdef MACOS_TRADITIONAL
PerlIO_printf(PerlIO_stdout(),
"\nMac OS port Copyright 1991-2002, Matthias Neeracher;\n"
return s;
case '*':
case ' ':
- if (s[1] == '-') /* Additional switches on #! line. */
- return s+2;
+ while( *s == ' ' )
+ ++s;
+ if (s[0] == '-') /* Additional switches on #! line. */
+ return s+1;
break;
case '-':
case 0:
of the SvREFCNT_dec, only to add it again with hv_name_set */
SvREFCNT_dec(GvHV(gv));
hv_name_set(PL_defstash, "main", 4, 0);
- GvHV(gv) = (HV*)SvREFCNT_inc_simple(PL_defstash);
+ GvHV(gv) = MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash));
SvREADONLY_on(gv);
PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpvs("INC", GV_ADD|GV_NOTQUAL,
SVt_PVAV)));
gv_SVadd(PL_errgv);
#endif
sv_grow(ERRSV, 240); /* Preallocate - for immediate signals. */
- sv_setpvn(ERRSV, "", 0);
+ CLEAR_ERRSV();
PL_curstash = PL_defstash;
CopSTASH_set(&PL_compiling, PL_defstash);
PL_debstash = GvHV(gv_fetchpvs("DB::", GV_ADDMULTI, SVt_PVHV));
if (PL_euid != PL_uid || PL_egid != PL_gid) { /* (suidperl doesn't exist, in fact) */
# ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
+ dVAR;
+
PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf); /* may be either wrapped or real suid */
if ((PL_euid != PL_uid && PL_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID)
||
environ[0] = NULL;
}
if (env) {
- char *s;
+ char *s, *old_var;
SV *sv;
for (; *env; env++) {
- if (!(s = strchr(*env,'=')) || s == *env)
+ old_var = *env;
+
+ if (!(s = strchr(old_var,'=')) || s == old_var)
continue;
+
#if defined(MSDOS) && !defined(DJGPP)
*s = '\0';
- (void)strupr(*env);
+ (void)strupr(old_var);
*s = '=';
#endif
sv = newSVpv(s+1, 0);
- (void)hv_store(hv, *env, s - *env, sv, 0);
+ (void)hv_store(hv, old_var, s - old_var, sv, 0);
if (env_is_not_environ)
mg_set(sv);
}
PERL_ARGS_ASSERT_CALL_LIST;
while (av_len(paramList) >= 0) {
- cv = (CV*)av_shift(paramList);
+ cv = MUTABLE_CV(av_shift(paramList));
if (PL_savebegin) {
if (paramList == PL_beginav) {
/* save PL_beginav for compiler */
projects / p5sagit/p5-mst-13.2.git / blobdiff