my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
S_init_tls_and_interp(my_perl);
- return ZeroD(my_perl, 1, PerlInterpreter);
+ return (PerlInterpreter *) ZeroD(my_perl, 1, PerlInterpreter);
}
#endif /* PERL_IMPLICIT_SYS */
if (SvTYPE(sv) != SVTYPEMASK) {
PerlIO_printf(Perl_debug_log, "leaked: sv=0x%p"
" flags=0x08%"UVxf
- " refcnt=%"UVuf pTHX__FORMAT "\n",
- sv, sv->sv_flags, sv->sv_refcnt pTHX__VALUE);
+ " refcnt=%"UVuf pTHX__FORMAT "\n"
+ "\tallocated at %s:%d %s %s%s\n",
+ sv, sv->sv_flags, sv->sv_refcnt pTHX__VALUE,
+ sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
+ sv->sv_debug_line,
+ sv->sv_debug_inpad ? "for" : "by",
+ sv->sv_debug_optype ?
+ PL_op_name[sv->sv_debug_optype]: "(none)",
+ sv->sv_debug_cloned ? " (cloned)" : ""
+ );
}
}
}
S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
{
int argc = PL_origargc;
- const char **argv = PL_origargv;
+ char **argv = PL_origargv;
const char *scriptname = NULL;
VOL bool dosearch = FALSE;
const char *validarg = "";
while (SvCUR(PL_Sv) > opts+76) {
/* find last space after "options: " and before col 76 */
- char *space, *pv = SvPV_nolen(PL_Sv);
- char c = pv[opts+76];
+ const char *space;
+ char *pv = SvPV_nolen(PL_Sv);
+ const char c = pv[opts+76];
pv[opts+76] = '\0';
space = strrchr(pv+opts+26, ' ');
pv[opts+76] = c;
}
/* catch use of gnu style long options */
if (strEQ(s, "version")) {
- s = "v";
+ s = (char *)"v";
goto reswitch;
}
if (strEQ(s, "help")) {
- s = "h";
+ s = (char *)"h";
goto reswitch;
}
s--;
if (PL_doextract) {
#endif
find_beginning();
- if (cddir && PerlDir_chdir(cddir) < 0)
+ if (cddir && PerlDir_chdir( (char *)cddir ) < 0)
Perl_croak(aTHX_ "Can't chdir to %s",cddir);
}
}
-STATIC void *
+STATIC void
S_run_body(pTHX_ I32 oldscope)
{
DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support.\n",
my_exit(0);
/* NOTREACHED */
- return NULL;
}
/*
*/
I32
-Perl_call_argv(pTHX_ const char *sub_name, I32 flags, register const char **argv)
+Perl_call_argv(pTHX_ const char *sub_name, I32 flags, register char **argv)
/* See G_* flags in cop.h */
/* null terminated arg list */
}
STATIC void
-S_call_body(pTHX_ const OP *myop, int is_eval)
+S_call_body(pTHX_ const OP *myop, bool is_eval)
{
if (PL_op == myop) {
if (is_eval)
}
case 'C':
s++;
- PL_unicode = parse_unicode_opts(&s);
+ PL_unicode = parse_unicode_opts( (const char **)&s );
return s;
case 'F':
PL_minus_F = TRUE;
/* The following permits -d:Mod to accepts arguments following an =
in the fashion that -MSome::Mod does. */
if (*s == ':' || *s == '=') {
- char *start;
+ const char *start;
SV *sv;
sv = newSVpv("use Devel::", 0);
start = ++s;
#ifdef DEBUGGING
forbid_setid("-D");
s++;
- PL_debug = get_debug_opts(&s, 1) | DEBUG_TOP_FLAG;
+ PL_debug = get_debug_opts( (const char **)&s, 1) | DEBUG_TOP_FLAG;
#else /* !DEBUGGING */
if (ckWARN_d(WARN_DEBUGGING))
Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
/* PSz 18 Nov 03 fdscript now global but do not change prototype */
STATIC void
-S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv)
+S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
{
#ifndef IAMSUID
const char *quote;
}
else {
/* if find_script() returns, it returns a malloc()-ed value */
- PL_origfilename = scriptname = find_script(scriptname, dosearch, NULL, 1);
+ scriptname = PL_origfilename = find_script(scriptname, dosearch, NULL, 1);
if (strnEQ(scriptname, "/dev/fd/", 8) && isDIGIT(scriptname[8]) ) {
const char *s = scriptname + 8;
}
scriptname = savepv(s + 1);
Safefree(PL_origfilename);
- PL_origfilename = scriptname;
+ PL_origfilename = (char *)scriptname;
}
}
}
CopFILE_free(PL_curcop);
CopFILE_set(PL_curcop, PL_origfilename);
if (*PL_origfilename == '-' && PL_origfilename[1] == '\0')
- scriptname = "";
+ scriptname = (char *)"";
if (PL_fdscript >= 0) {
PL_rsfp = PerlIO_fdopen(PL_fdscript,PERL_SCRIPT_MODE);
# if defined(HAS_FCNTL) && defined(F_SETFD)
}
#else /* IAMSUID */
else if (PL_preprocess) {
- char *cpp_cfg = CPPSTDIN;
+ const char *cpp_cfg = CPPSTDIN;
SV *cpp = newSVpvn("",0);
SV *cmd = NEWSV(0,0);
"PL_preprocess: cmd=\"%s\"\n",
SvPVX(cmd)));
- PL_rsfp = PerlProc_popen(SvPVX(cmd), "r");
+ PL_rsfp = PerlProc_popen(SvPVX(cmd), (char *)"r");
SvREFCNT_dec(cmd);
SvREFCNT_dec(cpp);
}
/* not set-id, must be wrapped */
}
#endif /* DOSUID */
+ (void)validarg;
+ (void)scriptname;
}
STATIC void
S_find_beginning(pTHX)
{
- register char *s, *s2;
+ register char *s;
+ register const char *s2;
#ifdef MACOS_TRADITIONAL
int maclines = 0;
#endif
* before even the options are parsed, so PL_tainting has
* not been initialized properly. */
bool
-Perl_doing_taint(int argc, const char *argv[], const char *envp[])
+Perl_doing_taint(int argc, char *argv[], char *envp[])
{
#ifndef PERL_IMPLICIT_SYS
/* If we have PERL_IMPLICIT_SYS we can't call getuid() et alia
int euid = PerlProc_geteuid();
int gid = PerlProc_getgid();
int egid = PerlProc_getegid();
+ (void)envp;
#ifdef VMS
uid |= gid << 16;
PL_DBgv = gv_fetchpv("DB::DB", GV_ADDMULTI, SVt_PVGV);
PL_DBline = gv_fetchpv("DB::dbline", GV_ADDMULTI, SVt_PVAV);
PL_DBsub = gv_HVadd(gv_fetchpv("DB::sub", GV_ADDMULTI, SVt_PVHV));
- sv_upgrade(GvSV(PL_DBsub), SVt_IV); /* IVX accessed if PERLDB_SUB_NN */
PL_DBsingle = GvSV((gv_fetchpv("DB::single", GV_ADDMULTI, SVt_PV)));
sv_setiv(PL_DBsingle, 0);
PL_DBtrace = GvSV((gv_fetchpv("DB::trace", GV_ADDMULTI, SVt_PV)));
}
void
-Perl_init_argv_symbols(pTHX_ register int argc, register const char **argv)
+Perl_init_argv_symbols(pTHX_ register int argc, register char **argv)
{
char *s;
argc--,argv++; /* skip name of script */
}
STATIC void
-S_incpush(pTHX_ const char *p, int addsubdirs, int addoldvers, int usesep,
- int canrelocate)
+S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep,
+ bool canrelocate)
{
SV *subdir = Nullsv;
+ const char *p = dir;
if (!p || !*p)
return;
sv_catpv(libdir, ":");
#endif
+ /* Do the if() outside the #ifdef to avoid warnings about an unused
+ parameter. */
+ if (canrelocate) {
#ifdef PERL_RELOCATABLE_INC
/*
* Relocatable include entries are marked with a leading .../
* The intent is that /usr/local/bin/perl and .../../lib/perl5
* generates /usr/local/lib/perl5
*/
- {
char *libpath = SvPVX(libdir);
STRLEN libpath_len = SvCUR(libdir);
if (libpath_len >= 4 && memEQ (libpath, ".../", 4)) {
}
SvREFCNT_dec(prefix_sv);
}
- }
#endif
+ }
/*
* BEFORE pushing libdir onto @INC we may first push version- and
* archname-specific sub-directories.
SvFLAGS(PL_thrsv) = SVt_PV;
SvANY(PL_thrsv) = (void*)xpv;
SvREFCNT(PL_thrsv) = 1 << 30; /* practically infinite */
- SvPVX(PL_thrsv) = (char*)thr;
+ SvPV_set(PL_thrsvr, (char*)thr);
SvCUR_set(PL_thrsv, sizeof(thr));
SvLEN_set(PL_thrsv, sizeof(thr));
*SvEND(PL_thrsv) = '\0'; /* in the trailing_nul field */
Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
{
SV *atsv;
- line_t oldline = CopLINE(PL_curcop);
+ const line_t oldline = CopLINE(PL_curcop);
CV *cv;
STRLEN len;
int ret;
read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen)
{
char *p, *nl;
+ (void)idx;
+ (void)maxlen;
+
p = SvPVX(PL_e_script);
nl = strchr(p, '\n');
nl = (nl) ? nl+1 : SvEND(PL_e_script);