From: Nicholas Clark Date: Thu, 30 Jun 2005 17:05:13 +0000 (+0000) Subject: Avoid using PL_Sv in the -V argument processing. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7edfd0ef07bb2042adfd7871ecb385475da3f544;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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++;