[patch] B portability macros
[p5sagit/p5-mst-13.2.git] / perl.c
diff --git a/perl.c b/perl.c
index bb35671..02a889d 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -125,16 +125,22 @@ char *getenv (char *); /* Usually in <stdlib.h> */
 
 static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen);
 
-#ifdef IAMSUID
-#ifndef DOSUID
-#define DOSUID
-#endif
-#endif /* IAMSUID */
-
-#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
 #ifdef DOSUID
-#undef DOSUID
-#endif
+#  ifdef IAMSUID
+/* Drop scriptname */
+#    define validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv, rsfp) S_validate_suid(aTHX_ validarg, fdscript, suidscript, linestr_sv, rsfp)
+#  else
+/* Drop suidscript */
+#    define validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv, rsfp) S_validate_suid(aTHX_ validarg, scriptname, fdscript, linestr_sv, rsfp)
+#  endif
+#else
+#  ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
+/* Drop everything. Heck, don't even try to call it */
+#    define validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv, rsfp) NOOP
+#  else
+/* Drop almost everything */
+#    define validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv, rsfp) S_validate_suid(aTHX_ rsfp)
+#  endif
 #endif
 
 #define CALL_BODY_EVAL(myop) \
@@ -204,7 +210,7 @@ Perl_sys_init3(int* argc, char*** argv, char*** env)
 }
 
 void
-Perl_sys_term(pTHX)
+Perl_sys_term()
 {
     dVAR;
     if (!PL_veto_cleanup) {
@@ -300,15 +306,19 @@ perl_construct(pTHXx)
 
     sv_setpv(&PL_sv_no,PL_No);
     /* value lookup in void context - happens to have the side effect
-       of caching the numeric forms.  */
-    SvIV(&PL_sv_no);
+       of caching the numeric forms. However, as &PL_sv_no doesn't contain
+       a string that is a valid numer, we have to turn the public flags by
+       hand:  */
     SvNV(&PL_sv_no);
+    SvIV(&PL_sv_no);
+    SvIOK_on(&PL_sv_no);
+    SvNOK_on(&PL_sv_no);
     SvREADONLY_on(&PL_sv_no);
     SvREFCNT(&PL_sv_no) = (~(U32)0)/2;
 
     sv_setpv(&PL_sv_yes,PL_Yes);
-    SvIV(&PL_sv_yes);
     SvNV(&PL_sv_yes);
+    SvIV(&PL_sv_yes);
     SvREADONLY_on(&PL_sv_yes);
     SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
 
@@ -349,8 +359,9 @@ perl_construct(pTHXx)
     sv_setpvn(PERL_DEBUG_PAD(1), "", 0);       /* ext/re needs these */
     sv_setpvn(PERL_DEBUG_PAD(2), "", 0);       /* even without DEBUGGING. */
 #ifdef USE_ITHREADS
-    /* First entry is an array of empty elements */
-    Perl_av_create_and_push(aTHX_ &PL_regex_padav,(SV*)newAV());
+    /* First entry is a list of empty elements. It needs to be initialised
+       else all hell breaks loose in S_find_uninit_var().  */
+    Perl_av_create_and_push(aTHX_ &PL_regex_padav, newSVpvs(""));
     PL_regex_pad = AvARRAY(PL_regex_padav);
 #endif
 #ifdef USE_REENTRANT_API
@@ -563,7 +574,7 @@ int
 perl_destruct(pTHXx)
 {
     dVAR;
-    VOL int destruct_level;  /* 0=none, 1=full, 2=full with checks */
+    VOL signed char destruct_level;  /* see possible values in intrpvar.h */
     HV *hv;
 #ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
     pid_t child;
@@ -868,28 +879,6 @@ perl_destruct(pTHXx)
      * REGEXPs in the parent interpreter
      * we need to manually ReREFCNT_dec for the clones
      */
-    {
-        I32 i = AvFILLp(PL_regex_padav) + 1;
-        SV * const * const ary = AvARRAY(PL_regex_padav);
-
-        while (i) {
-            SV * const resv = ary[--i];
-
-            if (SvFLAGS(resv) & SVf_BREAK) {
-                /* this is PL_reg_curpm, already freed
-                 * flag is set in regexec.c:S_regtry
-                 */
-                SvFLAGS(resv) &= ~SVf_BREAK;
-            }
-           else if(SvREPADTMP(resv)) {
-             SvREPADTMP_off(resv);
-           }
-            else if(SvIOKp(resv)) {
-               REGEXP *re = INT2PTR(REGEXP *,SvIVX(resv));
-                ReREFCNT_dec(re);
-            }
-        }
-    }
     SvREFCNT_dec(PL_regex_padav);
     PL_regex_padav = NULL;
     PL_regex_pad = NULL;
@@ -912,7 +901,6 @@ perl_destruct(pTHXx)
     }
 
     /* switches */
-    PL_preprocess   = FALSE;
     PL_minus_n      = FALSE;
     PL_minus_p      = FALSE;
     PL_minus_l      = FALSE;
@@ -1223,7 +1211,8 @@ perl_destruct(pTHXx)
                        " flags=0x%"UVxf
                        " refcnt=%"UVuf pTHX__FORMAT "\n"
                        "\tallocated at %s:%d %s %s%s\n",
-                       (void*)sv, sv->sv_flags, sv->sv_refcnt pTHX__VALUE,
+                       (void*)sv, (UV)sv->sv_flags, (UV)sv->sv_refcnt
+                       pTHX__VALUE,
                        sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
                        sv->sv_debug_line,
                        sv->sv_debug_inpad ? "for" : "by",
@@ -1257,6 +1246,10 @@ perl_destruct(pTHXx)
     }
 #endif
 #endif
+#ifdef DEBUG_LEAKING_SCALARS_ABORT
+    if (PL_sv_count)
+       abort();
+#endif
     PL_sv_count = 0;
 
 #ifdef PERL_DEBUG_READONLY_OPS
@@ -1499,12 +1492,9 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
 
     PERL_UNUSED_ARG(my_perl);
 
-#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
-#ifdef IAMSUID
-#undef IAMSUID
-    Perl_croak(aTHX_ "suidperl is no longer needed since the kernel can now execute\n\
-setuid perl scripts securely.\n");
-#endif /* IAMSUID */
+#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW_AND_IAMSUID
+    Perl_croak(aTHX_ "suidperl is no longer needed since the kernel can now "
+              "execute\nsetuid perl scripts securely.\n");
 #endif
 
 #if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT)
@@ -1687,7 +1677,9 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     char **argv = PL_origargv;
     const char *scriptname = NULL;
     VOL bool dosearch = FALSE;
+#ifdef DOSUID
     const char *validarg = "";
+#endif
     register SV *sv;
     register char c;
     const char *cddir = NULL;
@@ -1777,7 +1769,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
            if (argv[1] && !strcmp(argv[1], "Dev:Pseudo"))
                break;
 #endif
-           forbid_setid('e', -1);
+           forbid_setid('e', FALSE);
            if (!PL_e_script) {
                PL_e_script = newSVpvs("");
                add_read_e_script = TRUE;
@@ -1801,7 +1793,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
            goto reswitch;
 
        case 'I':       /* -I handled both here and in moreswitches() */
-           forbid_setid('I', -1);
+           forbid_setid('I', FALSE);
            if (!*++s && (s=argv[1]) != NULL) {
                argc--,argv++;
            }
@@ -1817,14 +1809,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
            else
                Perl_croak(aTHX_ "No directory specified for -I");
            break;
-       case 'P':
-           forbid_setid('P', -1);
-           PL_preprocess = TRUE;
-           s++;
-           deprecate("-P");
-           goto reswitch;
        case 'S':
-           forbid_setid('S', -1);
+           forbid_setid('S', FALSE);
            dosearch = TRUE;
            s++;
            goto reswitch;
@@ -1899,12 +1885,10 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                                   "\"  Built under %s\\n",OSNAME);
 #ifdef __DATE__
 #  ifdef __TIME__
-                   Perl_sv_catpvf(aTHX_ opts_prog,
-                                  "  Compiled at %s %s\\n\"",__DATE__,
-                                  __TIME__);
+                   sv_catpvs(opts_prog,
+                             "  Compiled at " __DATE__ " " __TIME__ "\\n\"");
 #  else
-                   Perl_sv_catpvf(aTHX_ opts_prog,"  Compiled on %s\\n\"",
-                                  __DATE__);
+                   sv_catpvs(opts_prog, "  Compiled on " __DATE__ "\\n\"");
 #  endif
 #endif
                    sv_catpvs(opts_prog, "; $\"=\"\\n    \"; "
@@ -2048,9 +2032,12 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     init_perllib();
 
     {
-       int suidscript;
-       const int fdscript
-           = open_script(scriptname, dosearch, sv, &suidscript, &rsfp);
+       bool suidscript = FALSE;
+
+#ifdef DOSUID
+       const int fdscript =
+#endif
+           open_script(scriptname, dosearch, &suidscript, &rsfp);
 
        validate_suid(validarg, scriptname, fdscript, suidscript,
                linestr_sv, rsfp);
@@ -2078,10 +2065,10 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #endif
            ) {
 
-           /* This will croak if suidscript is >= 0, as -x cannot be used with
+           /* This will croak if suidscript is true, as -x cannot be used with
               setuid scripts.  */
            forbid_setid('x', suidscript);
-           /* Hence you can't get here if suidscript >= 0  */
+           /* Hence you can't get here if suidscript is true */
 
            find_beginning(linestr_sv, rsfp);
            if (cddir && PerlDir_chdir( (char *)cddir ) < 0)
@@ -2238,7 +2225,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #endif
     CopLINE_set(PL_curcop, 0);
     PL_curstash = PL_defstash;
-    PL_preprocess = FALSE;
     if (PL_e_script) {
        SvREFCNT_dec(PL_e_script);
        PL_e_script = NULL;
@@ -2481,8 +2467,7 @@ Perl_get_cvn_flags(pTHX_ const char *name, STRLEN len, I32 flags)
      * It has the same effect as "sub name;", i.e. just a forward
      * declaration! */
     if ((flags & ~GV_NOADD_MASK) && !GvCVu(gv)) {
-       SV *const sv = newSVpvn(name,len);
-       SvFLAGS(sv) |= flags & SVf_UTF8;
+       SV *const sv = newSVpvn_flags(name, len, flags & SVf_UTF8);
        return newSUB(start_subparse(FALSE, 0),
                      newSVOP(OP_CONST, 0, sv),
                      NULL, NULL);
@@ -2523,7 +2508,7 @@ Perl_call_argv(pTHX_ const char *sub_name, I32 flags, register char **argv)
     PUSHMARK(SP);
     if (argv) {
        while (*argv) {
-           XPUSHs(sv_2mortal(newSVpv(*argv,0)));
+           mXPUSHs(newSVpv(*argv,0));
            argv++;
        }
        PUTBACK;
@@ -2575,7 +2560,7 @@ L<perlcall>.
 */
 
 I32
-Perl_call_sv(pTHX_ SV *sv, I32 flags)
+Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
                        /* See G_* flags in cop.h */
 {
     dVAR; dSP;
@@ -2593,14 +2578,17 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
        ENTER;
        SAVETMPS;
     }
+    if (!(flags & G_WANT)) {
+       /* Backwards compatibility - as G_SCALAR was 0, it could be omitted.
+        */
+       flags |= G_SCALAR;
+    }
 
     Zero(&myop, 1, LOGOP);
     myop.op_next = NULL;
     if (!(flags & G_NOARGS))
        myop.op_flags |= OPf_STACKED;
-    myop.op_flags |= ((flags & G_VOID) ? OPf_WANT_VOID :
-                     (flags & G_ARRAY) ? OPf_WANT_LIST :
-                     OPf_WANT_SCALAR);
+    myop.op_flags |= OP_GIMME_REVERSE(flags);
     SAVEOP();
     PL_op = (OP*)&myop;
 
@@ -2622,7 +2610,9 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
        Zero(&method_op, 1, UNOP);
        method_op.op_next = PL_op;
        method_op.op_ppaddr = PL_ppaddr[OP_METHOD];
+       method_op.op_type = OP_METHOD;
        myop.op_ppaddr = PL_ppaddr[OP_ENTERSUB];
+       myop.op_type = OP_ENTERSUB;
        PL_op = (OP*)&method_op;
     }
 
@@ -2667,7 +2657,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
                goto redo_body;
            }
            PL_stack_sp = PL_stack_base + oldmark;
-           if (flags & G_ARRAY)
+           if ((flags & G_WANT) == G_ARRAY)
                retval = 0;
            else {
                retval = 1;
@@ -2730,9 +2720,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
        myop.op_flags = OPf_STACKED;
     myop.op_next = NULL;
     myop.op_type = OP_ENTEREVAL;
-    myop.op_flags |= ((flags & G_VOID) ? OPf_WANT_VOID :
-                     (flags & G_ARRAY) ? OPf_WANT_LIST :
-                     OPf_WANT_SCALAR);
+    myop.op_flags |= OP_GIMME_REVERSE(flags);
     if (flags & G_KEEPERR)
        myop.op_flags |= OPf_SPECIAL;
 
@@ -2768,7 +2756,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
            goto redo_body;
        }
        PL_stack_sp = PL_stack_base + oldmark;
-       if (flags & G_ARRAY)
+       if ((flags & G_WANT) == G_ARRAY)
            retval = 0;
        else {
            retval = 1;
@@ -2876,7 +2864,6 @@ S_usage(pTHX_ const char *name)           /* XXX move this out into a module ? */
 "-[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",
@@ -2916,7 +2903,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
       "  t  Trace execution",
       "  o  Method and overloading resolution",
       "  c  String/numeric conversions",
-      "  P  Print profiling info, preprocessor command for -P, source file input state",
+      "  P  Print profiling info, source file input state",
       "  m  Memory allocation",
       "  f  Format processing",
       "  r  Regular expression parsing and execution",
@@ -3038,7 +3025,7 @@ Perl_moreswitches(pTHX_ const char *s)
        s++;
        return s;
     case 'd':
-       forbid_setid('d', -1);
+       forbid_setid('d', FALSE);
        s++;
 
         /* -dt indicates to the debugger that threads will be used */
@@ -3050,20 +3037,21 @@ Perl_moreswitches(pTHX_ const char *s)
        /* The following permits -d:Mod to accepts arguments following an =
           in the fashion that -MSome::Mod does. */
        if (*s == ':' || *s == '=') {
-            const char *start;
+           const char *start = ++s;
+           const char *const end = s + strlen(s);
            SV * const sv = newSVpvs("use Devel::");
-           start = ++s;
+
            /* We now allow -d:Module=Foo,Bar */
            while(isALNUM(*s) || *s==':') ++s;
            if (*s != '=')
-               sv_catpv(sv, start);
+               sv_catpvn(sv, start, end - start);
            else {
                sv_catpvn(sv, start, s-start);
                /* Don't use NUL as q// delimiter here, this string goes in the
                 * environment. */
                Perl_sv_catpvf(aTHX_ sv, " split(/,/,q{%s});", ++s);
            }
-           s += strlen(s);
+           s = end;
            my_setenv("PERL5DB", SvPV_nolen_const(sv));
            SvREFCNT_dec(sv);
        }
@@ -3075,7 +3063,7 @@ Perl_moreswitches(pTHX_ const char *s)
     case 'D':
     {  
 #ifdef DEBUGGING
-       forbid_setid('D', -1);
+       forbid_setid('D', FALSE);
        s++;
        PL_debug = get_debug_opts( (const char **)&s, 1) | DEBUG_TOP_FLAG;
 #else /* !DEBUGGING */
@@ -3111,7 +3099,7 @@ Perl_moreswitches(pTHX_ const char *s)
        }
        return s;
     case 'I':  /* -I handled both here and in parse_body() */
-       forbid_setid('I', -1);
+       forbid_setid('I', FALSE);
        ++s;
        while (*s && isSPACE(*s))
            ++s;
@@ -3160,12 +3148,13 @@ Perl_moreswitches(pTHX_ const char *s)
        }
        return s;
     case 'M':
-       forbid_setid('M', -1);  /* XXX ? */
+       forbid_setid('M', FALSE);       /* XXX ? */
        /* FALL THROUGH */
     case 'm':
-       forbid_setid('m', -1);  /* XXX ? */
+       forbid_setid('m', FALSE);       /* XXX ? */
        if (*++s) {
            const char *start;
+           const char *end;
            SV *sv;
            const char *use = "use ";
            /* -M-foo == 'no foo'       */
@@ -3176,8 +3165,9 @@ Perl_moreswitches(pTHX_ const char *s)
            start = s;
            /* We allow -M'Module qw(Foo Bar)'  */
            while(isALNUM(*s) || *s==':') ++s;
+           end = s + strlen(s);
            if (*s != '=') {
-               sv_catpv(sv, start);
+               sv_catpvn(sv, start, end - start);
                if (*(start-1) == 'm') {
                    if (*s != '\0')
                        Perl_croak(aTHX_ "Can't use '%c' after -mname", *s);
@@ -3188,12 +3178,13 @@ Perl_moreswitches(pTHX_ const char *s)
                     Perl_croak(aTHX_ "Module name required with -%c option",
                               s[-1]);
                sv_catpvn(sv, start, s-start);
-               sv_catpvs(sv, " split(/,/,q");
-               sv_catpvs(sv, "\0");        /* Use NUL as q//-delimiter. */
-               sv_catpv(sv, ++s);
+               /* Use NUL as q''-delimiter.  */
+               sv_catpvs(sv, " split(/,/,q\0");
+               ++s;
+               sv_catpvn(sv, s, end - s);
                sv_catpvs(sv,  "\0)");
            }
-           s += strlen(s);
+           s = end;
            Perl_av_create_and_push(aTHX_ &PL_preambleav, sv);
        }
        else
@@ -3208,7 +3199,7 @@ Perl_moreswitches(pTHX_ const char *s)
        s++;
        return s;
     case 's':
-       forbid_setid('s', -1);
+       forbid_setid('s', FALSE);
        PL_doswitches = TRUE;
        s++;
        return s;
@@ -3381,10 +3372,6 @@ Internet, point your browser at http://www.perl.org/, the Perl Home Page.\n\n");
     case 'S':                  /* OS/2 needs -S on "extproc" line. */
        break;
 #endif
-    case 'P':
-       if (PL_preprocess)
-           return s+1;
-       /* FALL THROUGH */
     default:
        Perl_croak(aTHX_ "Can't emulate -%.1s on #! line",s);
     }
@@ -3511,20 +3498,12 @@ S_init_main_stash(pTHX)
 }
 
 STATIC int
-S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv,
-             int *suidscript, PerlIO **rsfpp)
+S_open_script(pTHX_ const char *scriptname, bool dosearch,
+             bool *suidscript, PerlIO **rsfpp)
 {
-#ifndef IAMSUID
-    const char *quote;
-    const char *code;
-    const char *cpp_discard_flag;
-    const char *perl;
-#endif
     int fdscript = -1;
     dVAR;
 
-    *suidscript = -1;
-
     if (PL_e_script) {
        PL_origfilename = savepvs("-e");
     }
@@ -3547,7 +3526,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv,
                 * Is it a mistake to use a similar /dev/fd/ construct for
                 * suidperl?
                 */
-               *suidscript = 1;
+               *suidscript = TRUE;
                /* PSz 20 Feb 04  
                 * Be supersafe and do some sanity-checks.
                 * Still, can we be sure we got the right thing?
@@ -3590,76 +3569,10 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv,
  * perl with that fd as it has always done.
  */
     }
-    if (*suidscript != 1) {
+    if (*suidscript) {
        Perl_croak(aTHX_ "suidperl needs (suid) fd script\n");
     }
 #else /* IAMSUID */
-    else if (PL_preprocess) {
-       const char * const cpp_cfg = CPPSTDIN;
-       SV * const cpp = newSVpvs("");
-       SV * const cmd = newSV(0);
-
-       if (cpp_cfg[0] == 0) /* PERL_MICRO? */
-            Perl_croak(aTHX_ "Can't run with cpp -P with CPPSTDIN undefined");
-       if (strEQ(cpp_cfg, "cppstdin"))
-           Perl_sv_catpvf(aTHX_ cpp, "%s/", BIN_EXP);
-       sv_catpv(cpp, cpp_cfg);
-
-#       ifndef VMS
-           sv_catpvs(sv, "-I");
-           sv_catpv(sv,PRIVLIB_EXP);
-#       endif
-
-       DEBUG_P(PerlIO_printf(Perl_debug_log,
-                             "PL_preprocess: scriptname=\"%s\", cpp=\"%s\", sv=\"%s\", CPPMINUS=\"%s\"\n",
-                             scriptname, SvPVX_const (cpp), SvPVX_const (sv),
-                             CPPMINUS));
-
-#       if defined(MSDOS) || defined(WIN32) || defined(VMS)
-            quote = "\"";
-#       else
-            quote = "'";
-#       endif
-
-#       ifdef VMS
-            cpp_discard_flag = "";
-#       else
-            cpp_discard_flag = "-C";
-#       endif
-
-#       ifdef OS2
-            perl = os2_execname(aTHX);
-#       else
-            perl = PL_origargv[0];
-#       endif
-
-
-        /* This strips off Perl comments which might interfere with
-           the C pre-processor, including #!.  #line directives are
-           deliberately stripped to avoid confusion with Perl's version
-           of #line.  FWP played some golf with it so it will fit
-           into VMS's 255 character buffer.
-        */
-        if( PL_doextract )
-            code = "(1../^#!.*perl/i)|/^\\s*#(?!\\s*((ifn?|un)def|(el|end)?if|define|include|else|error|pragma)\\b)/||!($|=1)||print";
-        else
-            code = "/^\\s*#(?!\\s*((ifn?|un)def|(el|end)?if|define|include|else|error|pragma)\\b)/||!($|=1)||print";
-
-        Perl_sv_setpvf(aTHX_ cmd, "\
-%s -ne%s%s%s %s | %"SVf" %s %"SVf" %s",
-                       perl, quote, code, quote, scriptname, SVfARG(cpp),
-                       cpp_discard_flag, SVfARG(sv), CPPMINUS);
-
-       PL_doextract = FALSE;
-
-        DEBUG_P(PerlIO_printf(Perl_debug_log,
-                              "PL_preprocess: cmd=\"%s\"\n",
-                              SvPVX_const(cmd)));
-
-       *rsfpp = PerlProc_popen((char *)SvPVX_const(cmd), (char *)"r");
-       SvREFCNT_dec(cmd);
-       SvREFCNT_dec(cpp);
-    }
     else if (!*scriptname) {
        forbid_setid(0, *suidscript);
        *rsfpp = PerlIO_stdin();
@@ -3858,14 +3771,20 @@ S_fd_on_nosuid_fs(pTHX_ int fd)
 }
 #endif /* IAMSUID */
 
+#ifdef DOSUID
 STATIC void
-S_validate_suid(pTHX_ const char *validarg, const char *scriptname,
-               int fdscript, int suidscript, SV *linestr_sv, PerlIO *rsfp)
+S_validate_suid(pTHX_ const char *validarg,
+#  ifndef IAMSUID
+               const char *scriptname,
+#  endif
+               int fdscript,
+#  ifdef IAMSUID
+               bool suidscript,
+#  endif
+               SV *linestr_sv, PerlIO *rsfp)
 {
     dVAR;
-#ifdef IAMSUID
-    /* int which; */
-#endif /* IAMSUID */
+    const char *s, *s2;
 
     /* do we need to emulate setuid on scripts? */
 
@@ -3894,9 +3813,6 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname,
      * Configure script will set this up for you if you want it.
      */
 
-#ifdef DOSUID
-    const char *s, *s2;
-
     if (PerlLIO_fstat(PerlIO_fileno(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)) {
@@ -3905,7 +3821,7 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname,
        const char *s_end;
 
 #  ifdef IAMSUID
-       if (fdscript < 0 || suidscript != 1)
+       if (fdscript < 0 || !suidscript)
            Perl_croak(aTHX_ "Need (suid) fdscript in suidperl\n");     /* We already checked this */
        /* PSz 11 Nov 03
         * Since the script is opened by perl, not suidperl, some of these
@@ -4182,9 +4098,7 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n");
            Perl_croak(aTHX_ "Effective UID cannot exec script\n");     /* they can't do this */
     }
 #  ifdef IAMSUID
-    else if (PL_preprocess)    /* PSz 13 Nov 03  Caught elsewhere, useless(?!) here */
-       Perl_croak(aTHX_ "-P not allowed for setuid/setgid script\n");
-    else if (fdscript < 0 || suidscript != 1)
+    else if (fdscript < 0 || !suidscript)
        /* PSz 13 Nov 03  Caught elsewhere, useless(?!) here */
        Perl_croak(aTHX_ "(suid) fdscript needed in suidperl\n");
     else {
@@ -4230,13 +4144,6 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n");
     /* PSz 11 Nov 03
      * Keep original arguments: suidperl already has fd script.
      */
-/*  for (which = 1; PL_origargv[which] && PL_origargv[which] != scriptname; which++) ; */
-/*  if (!PL_origargv[which]) {                                         */
-/*     errno = EPERM;                                                  */
-/*     Perl_croak(aTHX_ "Permission denied\n");                        */
-/*  }                                                                  */
-/*  PL_origargv[which] = savepv(Perl_form(aTHX_ "/dev/fd/%d/%s",       */
-/*                               PerlIO_fileno(rsfp), PL_origargv[which]));    */
 #  if defined(HAS_FCNTL) && defined(F_SETFD)
     fcntl(PerlIO_fileno(rsfp),F_SETFD,0);      /* ensure no close-on-exec */
 #  endif
@@ -4247,13 +4154,18 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n");
     PERL_FPU_POST_EXEC
     Perl_croak(aTHX_ "Can't do setuid (suidperl cannot exec perl)\n");
 #  endif /* IAMSUID */
+}
+
 #else /* !DOSUID */
-    PERL_UNUSED_ARG(fdscript);
-    PERL_UNUSED_ARG(suidscript);
-    if (PL_euid != PL_uid || PL_egid != PL_gid) {      /* (suidperl doesn't exist, in fact) */
+
 #  ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
-    PERL_UNUSED_ARG(rsfp);
+/* Don't even need this function.  */
 #  else
+STATIC void
+S_validate_suid(pTHX_ PerlIO *rsfp)
+{
+    if (PL_euid != PL_uid || PL_egid != PL_gid) {      /* (suidperl doesn't exist, in fact) */
+#  ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
        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)
            ||
@@ -4265,11 +4177,9 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 #  endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
        /* not set-id, must be wrapped */
     }
-#endif /* DOSUID */
-    PERL_UNUSED_ARG(validarg);
-    PERL_UNUSED_ARG(scriptname);
-    PERL_UNUSED_ARG(linestr_sv);
 }
+#  endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
+#endif /* DOSUID */
 
 STATIC void
 S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp)
@@ -4408,7 +4318,7 @@ Perl_doing_taint(int argc, char *argv[], char *envp[])
    "program input from stdin", which is substituted in place of '\0', which
    could never be a command line flag.  */
 STATIC void
-S_forbid_setid(pTHX_ const char flag, const int suidscript)
+S_forbid_setid(pTHX_ const char flag, const bool suidscript) /* g */
 {
     dVAR;
     char string[3] = "-x";
@@ -4447,7 +4357,7 @@ S_forbid_setid(pTHX_ const char flag, const int suidscript)
      * 
      * Also see comments about root running a setuid script, elsewhere.
      */
-    if (suidscript >= 0)
+    if (suidscript)
         Perl_croak(aTHX_ "No %s allowed with (suid) fdscript", message);
 #ifdef IAMSUID
     /* PSz 11 Nov 03  Catch it in suidperl, always! */
@@ -4949,7 +4859,8 @@ S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep,
                   SvPOK() won't be true.  */
                assert(caret_X);
                assert(SvPOKp(caret_X));
-               prefix_sv = newSVpvn(SvPVX(caret_X), SvCUR(caret_X));
+               prefix_sv = newSVpvn_flags(SvPVX(caret_X), SvCUR(caret_X),
+                                          SvUTF8(caret_X));
                /* Firstly take off the leading .../
                   If all else fail we'll do the paths relative to the current
                   directory.  */