S_del_body is sufficiently small that inlining it is a space win.
[p5sagit/p5-mst-13.2.git] / perl.c
diff --git a/perl.c b/perl.c
index 0992786..62b128a 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1282,7 +1282,9 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     register SV *sv;
     register char *s;
     const char *cddir = Nullch;
+#ifdef USE_SITECUSTOMIZE
     bool minus_f = FALSE;
+#endif
 
     PL_fdscript = -1;
     PL_suidscript = -1;
@@ -1377,7 +1379,9 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
            break;
 
        case 'f':
+#ifdef USE_SITECUSTOMIZE
            minus_f = TRUE;
+#endif
            s++;
            goto reswitch;
 
@@ -2427,37 +2431,35 @@ S_usage(pTHX_ const char *name)         /* XXX move this out into a module ? */
      * 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
 };
@@ -2652,7 +2654,6 @@ Perl_moreswitches(pTHX_ char *s)
                   "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':
@@ -2668,8 +2669,8 @@ Perl_moreswitches(pTHX_ char *s)
        }
 #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. */
@@ -2729,17 +2730,27 @@ Perl_moreswitches(pTHX_ char *s)
        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 */
@@ -3178,7 +3189,8 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
 
        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 = "\"";
@@ -3219,9 +3231,9 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
 
         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);
     }
@@ -3829,7 +3841,6 @@ S_find_beginning(pTHX)
                while (isDIGIT(s2[-1]) || s2[-1] == '-' || s2[-1] == '.'
                       || s2[-1] == '_') s2--;
                if (strnEQ(s2-4,"perl",4))
-                   /*SUPPRESS 530*/
                    while ((s = moreswitches(s)))
                        ;
            }
@@ -4359,7 +4370,7 @@ STATIC SV *
 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);
@@ -4837,11 +4848,11 @@ S_my_exit_jump(pTHX)
 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) {