Avoid using PL_Sv in the -V argument processing.

Express the embedded perl program in a slightly terser way.

p4raw-id: //depot/perl@25027

diff --git a/perl.c b/perl.c
index f67d749..57a9471 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1709,116 +1709,130 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
            s++;
            goto reswitch;
        case 'V':
-           if (!PL_preambleav)
-               PL_preambleav = newAV();
-           av_push(PL_preambleav, newSVpv("use Config qw(myconfig config_vars)",0));
-           if (*++s != ':')  {
-                STRLEN opts;
-
-               PL_Sv = newSVpv("print myconfig();",0);
+           {
+               SV *opts_prog;
+
+               if (!PL_preambleav)
+                   PL_preambleav = newAV();
+               av_push(PL_preambleav,
+                       newSVpv("use Config;",0));
+               if (*++s != ':')  {
+                   STRLEN opts;
+               
+                   opts_prog = newSVpv("print Config::myconfig(),",0);
 #ifdef VMS
-               sv_catpv(PL_Sv,"print \"\\nCharacteristics of this PERLSHR image: \\n\",");
+                   sv_catpv(opts_prog,"\"\\nCharacteristics of this PERLSHR image: \\n\",");
 #else
-               sv_catpv(PL_Sv,"print \"\\nCharacteristics of this binary (from libperl): \\n\",");
+                   sv_catpv(opts_prog,"\"\\nCharacteristics of this binary (from libperl): \\n\",");
 #endif
-                opts = SvCUR(PL_Sv);
+                   opts = SvCUR(opts_prog);
 
-               sv_catpv(PL_Sv,"\"  Compile-time options:");
+                   sv_catpv(opts_prog,"\"  Compile-time options:");
 #  ifdef DEBUGGING
-               sv_catpv(PL_Sv," DEBUGGING");
+                   sv_catpv(opts_prog," DEBUGGING");
 #  endif
 #  ifdef MULTIPLICITY
-               sv_catpv(PL_Sv," MULTIPLICITY");
+                   sv_catpv(opts_prog," MULTIPLICITY");
 #  endif
 #  ifdef USE_5005THREADS
-               sv_catpv(PL_Sv," USE_5005THREADS");
+                   sv_catpv(opts_prog," USE_5005THREADS");
 #  endif
 #  ifdef USE_ITHREADS
-               sv_catpv(PL_Sv," USE_ITHREADS");
+                   sv_catpv(opts_prog," USE_ITHREADS");
 #  endif
 #  ifdef USE_64_BIT_INT
-               sv_catpv(PL_Sv," USE_64_BIT_INT");
+                   sv_catpv(opts_prog," USE_64_BIT_INT");
 #  endif
 #  ifdef USE_64_BIT_ALL
-               sv_catpv(PL_Sv," USE_64_BIT_ALL");
+                   sv_catpv(opts_prog," USE_64_BIT_ALL");
 #  endif
 #  ifdef USE_LONG_DOUBLE
-               sv_catpv(PL_Sv," USE_LONG_DOUBLE");
+                   sv_catpv(opts_prog," USE_LONG_DOUBLE");
 #  endif
 #  ifdef USE_LARGE_FILES
-               sv_catpv(PL_Sv," USE_LARGE_FILES");
+                   sv_catpv(opts_prog," USE_LARGE_FILES");
 #  endif
 #  ifdef USE_SOCKS
-               sv_catpv(PL_Sv," USE_SOCKS");
+                   sv_catpv(opts_prog," USE_SOCKS");
 #  endif
 #  ifdef USE_SITECUSTOMIZE
-               sv_catpv(PL_Sv," USE_SITECUSTOMIZE");
+                   sv_catpv(opts_prog," USE_SITECUSTOMIZE");
 #  endif              
 #  ifdef PERL_IMPLICIT_CONTEXT
-               sv_catpv(PL_Sv," PERL_IMPLICIT_CONTEXT");
+                   sv_catpv(opts_prog," PERL_IMPLICIT_CONTEXT");
 #  endif
 #  ifdef PERL_IMPLICIT_SYS
-               sv_catpv(PL_Sv," PERL_IMPLICIT_SYS");
+                   sv_catpv(opts_prog," PERL_IMPLICIT_SYS");
 #  endif
 
-                while (SvCUR(PL_Sv) > opts+76) {
-                    /* find last space after "options: " and before col 76 */
+                   while (SvCUR(opts_prog) > opts+76) {
+                       /* find last space after "options: " and before col 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;
-                    if (!space) break; /* "Can't happen" */
+                       const char *space;
+                       char *pv = SvPV_nolen(opts_prog);
+                       const char c = pv[opts+76];
+                       pv[opts+76] = '\0';
+                       space = strrchr(pv+opts+26, ' ');
+                       pv[opts+76] = c;
+                       if (!space) break; /* "Can't happen" */
 
-                    /* break the line before that space */
+                       /* break the line before that space */
 
-                    opts = space - pv;
-                    sv_insert(PL_Sv, opts, 0,
-                              "\\n                       ", 25);
-                }
+                       opts = space - pv;
+                       sv_insert(opts_prog, opts, 0,
+                                 "\\n                       ", 25);
+                   }
 
-               sv_catpv(PL_Sv,"\\n\",");
+                   sv_catpv(opts_prog,"\\n\",");
 
 #if defined(LOCAL_PATCH_COUNT)
-               if (LOCAL_PATCH_COUNT > 0) {
-                   int i;
-                   sv_catpv(PL_Sv,"\"  Locally applied patches:\\n\",");
-                   for (i = 1; i <= LOCAL_PATCH_COUNT; i++) {
-                       if (PL_localpatches[i])
-                           Perl_sv_catpvf(aTHX_ PL_Sv,"q%c\t%s\n%c,",
-                                   0, PL_localpatches[i], 0);
+                   if (LOCAL_PATCH_COUNT > 0) {
+                       int i;
+                       sv_catpv(opts_prog,
+                                "\"  Locally applied patches:\\n\",");
+                       for (i = 1; i <= LOCAL_PATCH_COUNT; i++) {
+                           if (PL_localpatches[i])
+                               Perl_sv_catpvf(aTHX_ opts_prog,"q%c\t%s\n%c,",
+                                              0, PL_localpatches[i], 0);
+                       }
                    }
-               }
 #endif
-               Perl_sv_catpvf(aTHX_ PL_Sv,"\"  Built under %s\\n\"",OSNAME);
+                   Perl_sv_catpvf(aTHX_ opts_prog,
+                                  "\"  Built under %s\\n\"",OSNAME);
 #ifdef __DATE__
 #  ifdef __TIME__
-               Perl_sv_catpvf(aTHX_ PL_Sv,",\"  Compiled at %s %s\\n\"",__DATE__,__TIME__);
+                   Perl_sv_catpvf(aTHX_ opts_prog,
+                                  ",\"  Compiled at %s %s\\n\"",__DATE__,
+                                  __TIME__);
 #  else
-               Perl_sv_catpvf(aTHX_ PL_Sv,",\"  Compiled on %s\\n\"",__DATE__);
+                   Perl_sv_catpvf(aTHX_ opts_prog,",\"  Compiled on %s\\n\"",
+                                  __DATE__);
 #  endif
 #endif
-               sv_catpv(PL_Sv, "; \
-$\"=\"\\n    \"; \
-@env = map { \"$_=\\\"$ENV{$_}\\\"\" } sort grep {/^PERL/} keys %ENV; ");
+                   sv_catpv(opts_prog, "; $\"=\"\\n    \"; "
+                            "@env = map { \"$_=\\\"$ENV{$_}\\\"\" } "
+                            "sort grep {/^PERL/} keys %ENV; ");
 #ifdef __CYGWIN__
-               sv_catpv(PL_Sv,"\
-push @env, \"CYGWIN=\\\"$ENV{CYGWIN}\\\"\";");
+                   sv_catpv(opts_prog,
+                            "push @env, \"CYGWIN=\\\"$ENV{CYGWIN}\\\"\";");
 #endif
-               sv_catpv(PL_Sv, "\
-print \"  \\%ENV:\\n    @env\\n\" if @env; \
-print \"  \\@INC:\\n    @INC\\n\";");
-           }
-           else {
-               ++s;
-               PL_Sv = Perl_newSVpvf(aTHX_ "config_vars(qw%c%s%c)", 0, s, 0);
-               s += strlen(s);
+                   sv_catpv(opts_prog, 
+                            "print \"  \\%ENV:\\n    @env\\n\" if @env;"
+                            "print \"  \\@INC:\\n    @INC\\n\";");
+               }
+               else {
+                   ++s;
+                   opts_prog = Perl_newSVpvf(aTHX_
+                                             "Config::config_vars(qw%c%s%c)",
+                                             0, s, 0);
+                   s += strlen(s);
+               }
+               av_push(PL_preambleav, opts_prog);
+               /* don't look for script or read stdin */
+               scriptname = BIT_BUCKET;
+               goto reswitch;
            }
-           av_push(PL_preambleav, PL_Sv);
-           scriptname = BIT_BUCKET;    /* don't look for script or read stdin */
-           goto reswitch;
        case 'x':
            PL_doextract = TRUE;
            s++;