In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/ee8bc8b7e369e9f69b93c0b0a137db3c4886a1a3?hp=08ad9465eddc2d08165efd8d3767520c6897b2fe>
- Log ----------------------------------------------------------------- commit ee8bc8b7e369e9f69b93c0b0a137db3c4886a1a3 Author: Nicholas Clark <[email protected]> Date: Thu Nov 24 22:34:43 2011 +0100 Simplify S_parse_body() by calling S_usage() and S_minus_v() directly. Previously the code for "--help" and "--version" set a local variable to a string corresponding to the single character option ("h" or "v" respectively), then restarted the option parsing code, which would then call into Perl_moreswitches(), which would then use a switch statement to dispatch to the final code. This is not as clear as it could be. M perl.c commit c4bc78d9be684eaf7dff0317bf1eed861c385096 Author: Nicholas Clark <[email protected]> Date: Thu Nov 24 21:40:40 2011 +0100 Break the -v code out from Perl_moreswitches() into S_minus_v(). M embed.fnc M embed.h M perl.c M proto.h commit b6f82619da63473c236f7d338cafcc1bfd4bafe3 Author: Nicholas Clark <[email protected]> Date: Thu Nov 24 21:28:27 2011 +0100 Refactor S_usage() to take 0 parameters and exit directly(). This simplifies the code, as it's only called from one spot, in Perl_moreswitches(). M embed.fnc M embed.h M perl.c M proto.h ----------------------------------------------------------------------- Summary of changes: embed.fnc | 3 +- embed.h | 3 +- perl.c | 118 +++++++++++++++++++++++++++++++------------------------------ proto.h | 9 +++-- 4 files changed, 69 insertions(+), 64 deletions(-) diff --git a/embed.fnc b/embed.fnc index 0c3c3f8..4d2b666 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1756,10 +1756,11 @@ rs |void |my_exit_jump s |void |nuke_stacks s |int |open_script |NN const char *scriptname|bool dosearch \ |NN bool *suidscript|NN PerlIO **rsfpp -s |void |usage |NN const char *name +sr |void |usage #ifndef SETUID_SCRIPTS_ARE_SECURE_NOW so |void |validate_suid |NN PerlIO *rsfp #endif +sr |void |minus_v s |void* |parse_body |NULLOK char **env|XSINIT_t xsinit rs |void |run_body |I32 oldscope diff --git a/embed.h b/embed.h index d29c18a..03aefc1 100644 --- a/embed.h +++ b/embed.h @@ -1416,12 +1416,13 @@ #define init_postdump_symbols(a,b,c) S_init_postdump_symbols(aTHX_ a,b,c) #define init_predump_symbols() S_init_predump_symbols(aTHX) #define mayberelocate(a,b,c) S_mayberelocate(aTHX_ a,b,c) +#define minus_v() S_minus_v(aTHX) #define my_exit_jump() S_my_exit_jump(aTHX) #define nuke_stacks() S_nuke_stacks(aTHX) #define open_script(a,b,c,d) S_open_script(aTHX_ a,b,c,d) #define parse_body(a,b) S_parse_body(aTHX_ a,b) #define run_body(a) S_run_body(aTHX_ a) -#define usage(a) S_usage(aTHX_ a) +#define usage() S_usage(aTHX) # endif # if defined(PERL_IN_PP_C) #define do_chomp(a,b,c) S_do_chomp(aTHX_ a,b,c) diff --git a/perl.c b/perl.c index fe69e8c..66860ed 100644 --- a/perl.c +++ b/perl.c @@ -1938,15 +1938,12 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) argc--,argv++; goto switch_end; } - /* catch use of gnu style long options */ - if (strEQ(s, "version")) { - s = (char *)"v"; - goto reswitch; - } - if (strEQ(s, "help")) { - s = (char *)"h"; - goto reswitch; - } + /* catch use of gnu style long options. + Both of these exit immediately. */ + if (strEQ(s, "version")) + minus_v(); + if (strEQ(s, "help")) + usage(); s--; /* FALL THROUGH */ default: @@ -2912,7 +2909,7 @@ Perl_require_pv(pTHX_ const char *pv) } STATIC void -S_usage(pTHX_ const char *name) /* XXX move this out into a module ? */ +S_usage(pTHX) /* XXX move this out into a module ? */ { /* This message really ought to be max 23 lines. * Removed -h because the user already knows that option. Others? */ @@ -2955,13 +2952,12 @@ NULL const char * const *p = usage_msg; PerlIO *out = PerlIO_stdout(); - PERL_ARGS_ASSERT_USAGE; - PerlIO_printf(out, "\nUsage: %s [switches] [--] [programfile] [arguments]\n", - name); + PL_origargv[0]); while (*p) PerlIO_puts(out, *p++); + my_exit(0); } /* convert a string of -D options (or digits) into an int. @@ -3168,8 +3164,7 @@ Perl_moreswitches(pTHX_ const char *s) return s; } case 'h': - usage(PL_origargv[0]); - my_exit(0); + usage(); case 'i': Safefree(PL_inplace); #if defined(__CYGWIN__) /* do backup extension automagically */ @@ -3322,6 +3317,56 @@ Perl_moreswitches(pTHX_ const char *s) s++; return s; case 'v': + minus_v(); + case 'w': + if (! (PL_dowarn & G_WARN_ALL_MASK)) { + PL_dowarn |= G_WARN_ON; + } + s++; + return s; + case 'W': + PL_dowarn = G_WARN_ALL_ON|G_WARN_ON; + if (!specialWARN(PL_compiling.cop_warnings)) + PerlMemShared_free(PL_compiling.cop_warnings); + PL_compiling.cop_warnings = pWARN_ALL ; + s++; + return s; + case 'X': + PL_dowarn = G_WARN_ALL_OFF; + if (!specialWARN(PL_compiling.cop_warnings)) + PerlMemShared_free(PL_compiling.cop_warnings); + PL_compiling.cop_warnings = pWARN_NONE ; + s++; + return s; + case '*': + case ' ': + while( *s == ' ' ) + ++s; + if (s[0] == '-') /* Additional switches on #! line. */ + return s+1; + break; + case '-': + case 0: +#if defined(WIN32) || !defined(PERL_STRICT_CR) + case '\r': +#endif + case '\n': + case '\t': + break; +#ifdef ALTERNATE_SHEBANG + case 'S': /* OS/2 needs -S on "extproc" line. */ + break; +#endif + default: + Perl_croak(aTHX_ "Can't emulate -%.1s on #! line",s); + } + return NULL; +} + + +STATIC void +S_minus_v(pTHX) +{ if (!sv_derived_from(PL_patchlevel, "version")) upg_version(PL_patchlevel, TRUE); #if !defined(DGUX) @@ -3439,49 +3484,6 @@ Complete documentation for Perl, including FAQ lists, should be found on\n\ this system using \"man perl\" or \"perldoc perl\". If you have access to the\n\ Internet, point your browser at http://www.perl.org/, the Perl Home Page.\n\n"); my_exit(0); - case 'w': - if (! (PL_dowarn & G_WARN_ALL_MASK)) { - PL_dowarn |= G_WARN_ON; - } - s++; - return s; - case 'W': - PL_dowarn = G_WARN_ALL_ON|G_WARN_ON; - if (!specialWARN(PL_compiling.cop_warnings)) - PerlMemShared_free(PL_compiling.cop_warnings); - PL_compiling.cop_warnings = pWARN_ALL ; - s++; - return s; - case 'X': - PL_dowarn = G_WARN_ALL_OFF; - if (!specialWARN(PL_compiling.cop_warnings)) - PerlMemShared_free(PL_compiling.cop_warnings); - PL_compiling.cop_warnings = pWARN_NONE ; - s++; - return s; - case '*': - case ' ': - while( *s == ' ' ) - ++s; - if (s[0] == '-') /* Additional switches on #! line. */ - return s+1; - break; - case '-': - case 0: -#if defined(WIN32) || !defined(PERL_STRICT_CR) - case '\r': -#endif - case '\n': - case '\t': - break; -#ifdef ALTERNATE_SHEBANG - case 'S': /* OS/2 needs -S on "extproc" line. */ - break; -#endif - default: - Perl_croak(aTHX_ "Can't emulate -%.1s on #! line",s); - } - return NULL; } /* compliments of Tom Christiansen */ diff --git a/proto.h b/proto.h index 7cc4c08..d324314 100644 --- a/proto.h +++ b/proto.h @@ -5865,6 +5865,9 @@ STATIC SV* S_mayberelocate(pTHX_ const char *const dir, STRLEN len, U32 flags) #define PERL_ARGS_ASSERT_MAYBERELOCATE \ assert(dir) +STATIC void S_minus_v(pTHX) + __attribute__noreturn__; + STATIC void S_my_exit_jump(pTHX) __attribute__noreturn__; @@ -5880,10 +5883,8 @@ STATIC void* S_parse_body(pTHX_ char **env, XSINIT_t xsinit); STATIC void S_run_body(pTHX_ I32 oldscope) __attribute__noreturn__; -STATIC void S_usage(pTHX_ const char *name) - __attribute__nonnull__(pTHX_1); -#define PERL_ARGS_ASSERT_USAGE \ - assert(name) +STATIC void S_usage(pTHX) + __attribute__noreturn__; #endif #if defined(PERL_IN_PP_C) -- Perl5 Master Repository
