Down with C++ reserved names

[p5sagit/p5-mst-13.2.git] / perl.c

diff --git a/perl.c b/perl.c
index 4a925b0..9c859a4 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -827,8 +827,16 @@ perl_destruct(pTHXx)
                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)" : ""
+                   );
                }
            }
        }
@@ -1412,8 +1420,9 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                 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;
@@ -1482,11 +1491,11 @@ print \"  \\@INC:\\n    @INC\\n\";");
            }
            /* 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--;
@@ -1611,7 +1620,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
     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);
 
     }
@@ -1819,7 +1828,7 @@ perl_run(pTHXx)
 }
 
 
-STATIC void *
+STATIC void
 S_run_body(pTHX_ I32 oldscope)
 {
     DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support.\n",
@@ -1863,7 +1872,6 @@ S_run_body(pTHX_ I32 oldscope)
 
     my_exit(0);
     /* NOTREACHED */
-    return NULL;
 }
 
 /*
@@ -2191,7 +2199,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 }
 
 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)
@@ -2531,7 +2539,7 @@ Perl_moreswitches(pTHX_ char *s)
     }
     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;
@@ -2561,7 +2569,7 @@ Perl_moreswitches(pTHX_ char *s)
        /* 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;
@@ -2588,7 +2596,7 @@ Perl_moreswitches(pTHX_ char *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),
@@ -3016,7 +3024,7 @@ S_init_main_stash(pTHX)
 
 /* 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;
@@ -3033,7 +3041,7 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv)
     }
     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;
@@ -3063,7 +3071,7 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv)
                }
                scriptname = savepv(s + 1);
                Safefree(PL_origfilename);
-               PL_origfilename = scriptname;
+               PL_origfilename = (char *)scriptname;
            }
        }
     }
@@ -3071,7 +3079,7 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv)
     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)
@@ -3098,7 +3106,7 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv)
     }
 #else /* IAMSUID */
     else if (PL_preprocess) {
-       char *cpp_cfg = CPPSTDIN;
+       const char *cpp_cfg = CPPSTDIN;
        SV *cpp = newSVpvn("",0);
        SV *cmd = NEWSV(0,0);
 
@@ -3158,7 +3166,7 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv)
                               "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);
     }
@@ -3712,12 +3720,15 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
        /* 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
@@ -3827,6 +3838,7 @@ Perl_doing_taint(int argc, char *argv[], char *envp[])
     int euid = PerlProc_geteuid();
     int gid  = PerlProc_getgid();
     int egid = PerlProc_getegid();
+    (void)envp;
 
 #ifdef VMS
     uid  |=  gid << 16;
@@ -4298,10 +4310,11 @@ S_incpush_if_exists(pTHX_ SV *dir)
 }
 
 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;
@@ -4343,6 +4356,9 @@ S_incpush(pTHX_ const char *p, int addsubdirs, int addoldvers, int usesep,
            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 .../
@@ -4360,7 +4376,6 @@ S_incpush(pTHX_ const char *p, int addsubdirs, int addoldvers, int usesep,
         * 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)) {
@@ -4437,8 +4452,8 @@ S_incpush(pTHX_ const char *p, int addsubdirs, int addoldvers, int usesep,
                }
                SvREFCNT_dec(prefix_sv);
            }
-       }
 #endif
+       }
        /*
         * BEFORE pushing libdir onto @INC we may first push version- and
         * archname-specific sub-directories.
@@ -4596,7 +4611,7 @@ void
 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;
@@ -4763,6 +4778,9 @@ static I32
 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);