if ((long) PL_mmap_page_size < 0) {
if (errno) {
SV *error = ERRSV;
- char *msg;
- STRLEN n_a;
(void) SvUPGRADE(error, SVt_PV);
- msg = SvPVx(error, n_a);
- Perl_croak(aTHX_ "panic: sysconf: %s", msg);
+ Perl_croak(aTHX_ "panic: sysconf: %s", SvPV_nolen_const(error));
}
else
Perl_croak(aTHX_ "panic: sysconf: pagesize unknown");
/* free the pointer tables used for cloning */
ptr_table_free(PL_ptr_table);
PL_ptr_table = (PTR_TBL_t*)NULL;
- ptr_table_free(PL_shared_hek_table);
- PL_shared_hek_table = (PTR_TBL_t*)NULL;
#endif
/* free special SVs */
Safefree(PL_psig_pend);
PL_psig_pend = (int*)NULL;
PL_formfeed = Nullsv;
- Safefree(PL_ofmt);
- PL_ofmt = Nullch;
nuke_stacks();
PL_tainting = FALSE;
PL_taint_warn = FALSE;
/* provide destructors to clean up the thread key when libperl is unloaded */
#ifndef WIN32 /* handled during DLL_PROCESS_DETACH in win32/perllib.c */
-#if defined(__hpux) && && __ux_version > 1020 && !defined(__GNUC__)
+#if defined(__hpux) && __ux_version > 1020 && !defined(__GNUC__)
#pragma fini "perl_fini"
#endif
register SV *sv;
register char *s;
const char *cddir = Nullch;
+#ifdef USE_SITECUSTOMIZE
bool minus_f = FALSE;
+#endif
PL_fdscript = -1;
PL_suidscript = -1;
break;
case 'f':
+#ifdef USE_SITECUSTOMIZE
minus_f = TRUE;
+#endif
s++;
goto reswitch;
UNOP myop; /* fake syntax tree node */
volatile I32 oldmark = SP - PL_stack_base;
volatile I32 retval = 0;
- I32 oldscope;
int ret;
OP* oldop = PL_op;
dJMPENV;
Zero(PL_op, 1, UNOP);
EXTEND(PL_stack_sp, 1);
*++PL_stack_sp = sv;
- oldscope = PL_scopestack_ix;
if (!(flags & G_NOARGS))
myop.op_flags = OPf_STACKED;
PUTBACK;
if (croak_on_error && SvTRUE(ERRSV)) {
- STRLEN n_a;
- Perl_croak(aTHX_ SvPVx(ERRSV, n_a));
+ Perl_croak(aTHX_ SvPVx_nolen_const(ERRSV));
}
return sv;
* Removed -h because the user already knows that option. Others? */
static const char * const usage_msg[] = {
-"-0[octal] specify record separator (\\0, if no argument)",
-"-A[name] activate all/given assertions",
-"-a autosplit mode with -n or -p (splits $_ into @F)",
-"-C[number/list] enables the listed Unicode features",
-"-c check syntax only (runs BEGIN and CHECK blocks)",
-"-d[:debugger] run program under debugger",
-"-D[number/list] set debugging flags (argument is a bit mask or alphabets)",
-"-e program one line of program (several -e's allowed, omit programfile)",
-#ifdef USE_SITECUSTOMIZE
-"-f don't do $sitelib/sitecustomize.pl at startup",
-#endif
-"-F/pattern/ split() pattern for -a switch (//'s are optional)",
-"-i[extension] edit <> files in place (makes backup if extension supplied)",
-"-Idirectory specify @INC/#include directory (several -I's allowed)",
-"-l[octal] enable line ending processing, specifies line terminator",
-"-[mM][-]module execute \"use/no module...\" before executing program",
-"-n assume \"while (<>) { ... }\" loop around program",
-"-p assume loop like -n but print line also, like sed",
-"-P run program through C preprocessor before compilation",
-"-s enable rudimentary parsing for switches after programfile",
-"-S look for programfile using PATH environment variable",
-"-t enable tainting warnings",
-"-T enable tainting checks",
-"-u dump core after parsing program",
-"-U allow unsafe operations",
-"-v print version, subversion (includes VERY IMPORTANT perl info)",
-"-V[:variable] print configuration summary (or a single Config.pm variable)",
-"-w enable many useful warnings (RECOMMENDED)",
-"-W enable all warnings",
-"-x[directory] strip off text before #!perl line and perhaps cd to directory",
-"-X disable all warnings",
+"-0[octal] specify record separator (\\0, if no argument)",
+"-A[mod][=pattern] activate all/given assertions",
+"-a autosplit mode with -n or -p (splits $_ into @F)",
+"-C[number/list] enables the listed Unicode features",
+"-c check syntax only (runs BEGIN and CHECK blocks)",
+"-d[:debugger] run program under debugger",
+"-D[number/list] set debugging flags (argument is a bit mask or alphabets)",
+"-e program one line of program (several -e's allowed, omit programfile)",
+"-f don't do $sitelib/sitecustomize.pl at startup",
+"-F/pattern/ split() pattern for -a switch (//'s are optional)",
+"-i[extension] edit <> files in place (makes backup if extension supplied)",
+"-Idirectory specify @INC/#include directory (several -I's allowed)",
+"-l[octal] enable line ending processing, specifies line terminator",
+"-[mM][-]module execute \"use/no module...\" before executing program",
+"-n assume \"while (<>) { ... }\" loop around program",
+"-p assume loop like -n but print line also, like sed",
+"-P run program through C preprocessor before compilation",
+"-s enable rudimentary parsing for switches after programfile",
+"-S look for programfile using PATH environment variable",
+"-t enable tainting warnings",
+"-T enable tainting checks",
+"-u dump core after parsing program",
+"-U allow unsafe operations",
+"-v print version, subversion (includes VERY IMPORTANT perl info)",
+"-V[:variable] print configuration summary (or a single Config.pm variable)",
+"-w enable many useful warnings (RECOMMENDED)",
+"-W enable all warnings",
+"-x[directory] strip off text before #!perl line and perhaps cd to directory",
+"-X disable all warnings",
"\n",
NULL
};
"Recompile perl with -DDEBUGGING to use -D switch (did you mean -d ?)\n");
for (s++; isALNUM(*s); s++) ;
#endif
- /*SUPPRESS 530*/
return s;
}
case 'h':
}
#endif /* __CYGWIN__ */
PL_inplace = savepv(s+1);
- /*SUPPRESS 530*/
- for (s = PL_inplace; *s && !isSPACE(*s); s++) ;
+ for (s = PL_inplace; *s && !isSPACE(*s); s++)
+ ;
if (*s) {
*s++ = '\0';
if (*s == '-') /* Additional switches on #! line. */
forbid_setid("-A");
if (!PL_preambleav)
PL_preambleav = newAV();
- if (*++s) {
- SV *sv = newSVpv("use assertions::activate split(/,/,q", 0);
- sv_catpvn(sv, "\0", 1); /* Use NUL as q//-delimiter. */
- sv_catpv(sv,s);
- sv_catpvn(sv, "\0)", 2);
- s+=strlen(s);
+ s++;
+ {
+ char *start = s;
+ SV *sv = newSVpv("use assertions::activate", 24);
+ while(isALNUM(*s) || *s == ':') ++s;
+ if (s != start) {
+ sv_catpvn(sv, "::", 2);
+ sv_catpvn(sv, start, s-start);
+ }
+ if (*s == '=') {
+ sv_catpvn(sv, " split(/,/,q\0", 13);
+ sv_catpv(sv, s+1);
+ sv_catpvn(sv, "\0)", 2);
+ s+=strlen(s);
+ }
+ else if (*s != '\0') {
+ Perl_croak(aTHX_ "Can't use '%c' after -A%.*s", *s, s-start, start);
+ }
av_push(PL_preambleav, sv);
+ return s;
}
- else
- av_push(PL_preambleav, newSVpvn("use assertions::activate",24));
- return s;
case 'M':
forbid_setid("-M"); /* XXX ? */
/* FALL THROUGH */
(void *)upg_version(PL_patchlevel);
#if !defined(DGUX)
PerlIO_printf(PerlIO_stdout(),
- Perl_form(aTHX_ "\nThis is perl, v%"SVf" built for %s",
+ Perl_form(aTHX_ "\nThis is perl, %"SVf" built for %s",
vstringify(PL_patchlevel),
ARCHNAME));
#else /* DGUX */
/* Adjust verbose output as in the perl that ships with the DG/UX OS from EMC */
PerlIO_printf(PerlIO_stdout(),
- Perl_form(aTHX_ "\nThis is perl, v%"SVf"\n",
+ Perl_form(aTHX_ "\nThis is perl, %"SVf"\n",
vstringify(PL_patchlevel)));
PerlIO_printf(PerlIO_stdout(),
Perl_form(aTHX_ " built under %s at %s %s\n",
DEBUG_P(PerlIO_printf(Perl_debug_log,
"PL_preprocess: scriptname=\"%s\", cpp=\"%s\", sv=\"%s\", CPPMINUS=\"%s\"\n",
- scriptname, SvPVX (cpp), SvPVX (sv), CPPMINUS));
+ scriptname, SvPVX_const (cpp), SvPVX_const (sv),
+ CPPMINUS));
# if defined(MSDOS) || defined(WIN32) || defined(VMS)
quote = "\"";
DEBUG_P(PerlIO_printf(Perl_debug_log,
"PL_preprocess: cmd=\"%s\"\n",
- SvPVX(cmd)));
+ SvPVX_const(cmd)));
- PL_rsfp = PerlProc_popen(SvPVX(cmd), (char *)"r");
+ PL_rsfp = PerlProc_popen((char *)SvPVX_const(cmd), (char *)"r");
SvREFCNT_dec(cmd);
SvREFCNT_dec(cpp);
}
*/
#ifdef DOSUID
- char *s, *s2;
+ const char *s, *s2;
if (PerlLIO_fstat(PerlIO_fileno(PL_rsfp),&PL_statbuf) < 0) /* normal stat is insecure */
Perl_croak(aTHX_ "Can't stat script \"%s\"",PL_origfilename);
if (PL_statbuf.st_mode & (S_ISUID|S_ISGID)) {
I32 len;
- STRLEN n_a;
+ const char *linestr;
#ifdef IAMSUID
if (PL_fdscript < 0 || PL_suidscript != 1)
PL_doswitches = FALSE; /* -s is insecure in suid */
/* PSz 13 Nov 03 But -s was caught elsewhere ... so unsetting it here is useless(?!) */
CopLINE_inc(PL_curcop);
+ linestr = SvPV_nolen_const(PL_linestr);
if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch ||
- strnNE(SvPV(PL_linestr,n_a),"#!",2) ) /* required even on Sys V */
+ strnNE(linestr,"#!",2) ) /* required even on Sys V */
Perl_croak(aTHX_ "No #! line");
- s = SvPV(PL_linestr,n_a)+2;
+ linestr+=2;
+ s = linestr;
/* PSz 27 Feb 04 */
/* Sanity check on line length */
if (strlen(s) < 1 || strlen(s) > 4000)
while (isSPACE(*s)) s++;
/* Sanity check on buffer end */
while ((*s) && !isSPACE(*s)) s++;
- for (s2 = s; (s2 > SvPV(PL_linestr,n_a)+2 &&
+ for (s2 = s; (s2 > linestr &&
(isDIGIT(s2[-1]) || s2[-1] == '.' || s2[-1] == '_'
|| s2[-1] == '-')); s2--) ;
/* Sanity check on buffer start */
- if ( (s2-4 < SvPV(PL_linestr,n_a)+2 || strnNE(s2-4,"perl",4)) &&
- (s-9 < SvPV(PL_linestr,n_a)+2 || strnNE(s-9,"perl",4)) )
+ if ( (s2-4 < linestr || strnNE(s2-4,"perl",4)) &&
+ (s-9 < linestr || strnNE(s-9,"perl",4)) )
Perl_croak(aTHX_ "Not a perl script");
while (*s == ' ' || *s == '\t') s++;
/*
while (isDIGIT(s2[-1]) || s2[-1] == '-' || s2[-1] == '.'
|| s2[-1] == '_') s2--;
if (strnEQ(s2-4,"perl",4))
- /*SUPPRESS 530*/
while ((s = moreswitches(s)))
;
}
S_incpush_if_exists(pTHX_ SV *dir)
{
Stat_t tmpstatbuf;
- if (PerlLIO_stat(SvPVX(dir), &tmpstatbuf) >= 0 &&
+ if (PerlLIO_stat(SvPVX_const(dir), &tmpstatbuf) >= 0 &&
S_ISDIR(tmpstatbuf.st_mode)) {
av_push(GvAVn(PL_incgv), dir);
dir = NEWSV(0,0);
case 0:
call_list_body(cv);
atsv = ERRSV;
- (void)SvPV(atsv, len);
+ (void)SvPV_const(atsv, len);
if (len) {
PL_curcop = &PL_compiling;
CopLINE_set(PL_curcop, oldline);
static I32
read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen)
{
- char *p, *nl;
+ const char *p, *nl;
(void)idx;
(void)maxlen;
- p = SvPVX(PL_e_script);
+ p = SvPVX_const(PL_e_script);
nl = strchr(p, '\n');
nl = (nl) ? nl+1 : SvEND(PL_e_script);
if (nl-p == 0) {