From: Nicholas Clark Date: Tue, 17 Feb 2009 23:24:32 +0000 (+0000) Subject: Pass the length of the string to S_incpush_use_sep(), where known. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=50d61629dc7fe34f077b9f66c50287d839e06378;p=p5sagit%2Fp5-mst-13.2.git Pass the length of the string to S_incpush_use_sep(), where known. --- diff --git a/embed.fnc b/embed.fnc index cd3e015..522cf7c 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1475,7 +1475,7 @@ s |void |find_beginning |NN SV* linestr_sv|NN PerlIO *rsfp s |void |forbid_setid |const char flag|const bool suidscript s |void |incpush |NULLOK const char *const dir|STRLEN len \ |U32 flags -s |void |incpush_use_sep|NN const char *p|U32 flags +s |void |incpush_use_sep|NN const char *p|STRLEN len|U32 flags s |void |init_interp s |void |init_ids s |void |init_main_stash diff --git a/embed.h b/embed.h index 0d3cbf3..cfe24ca 100644 --- a/embed.h +++ b/embed.h @@ -3627,7 +3627,7 @@ #define find_beginning(a,b) S_find_beginning(aTHX_ a,b) #define forbid_setid(a,b) S_forbid_setid(aTHX_ a,b) #define incpush(a,b,c) S_incpush(aTHX_ a,b,c) -#define incpush_use_sep(a,b) S_incpush_use_sep(aTHX_ a,b) +#define incpush_use_sep(a,b,c) S_incpush_use_sep(aTHX_ a,b,c) #define init_interp() S_init_interp(aTHX) #define init_ids() S_init_ids(aTHX) #define init_main_stash() S_init_main_stash(aTHX) diff --git a/perl.c b/perl.c index ba45aac..cf7ef08 100644 --- a/perl.c +++ b/perl.c @@ -4108,11 +4108,11 @@ S_init_perllib(pTHX_ U32 old_vers) #else if (s) #endif - incpush_use_sep(s, old_vers ? old_vers : INCPUSH_ADD_SUB_DIRS); + incpush_use_sep(s, 0, old_vers ? old_vers : INCPUSH_ADD_SUB_DIRS); else if (!old_vers) { s = PerlEnv_getenv("PERLLIB"); if (s) - incpush_use_sep(s, 0); + incpush_use_sep(s, 0, 0); } #else /* VMS */ /* Treat PERL5?LIB as a possible search list logical name -- the @@ -4123,11 +4123,11 @@ S_init_perllib(pTHX_ U32 old_vers) int idx = 0; if (my_trnlnm("PERL5LIB",buf,0)) do { - incpush_use_sep(buf, old_vers ? old_vers : INCPUSH_ADD_SUB_DIRS); + incpush_use_sep(buf, 0, old_vers ? old_vers : INCPUSH_ADD_SUB_DIRS); } while (my_trnlnm("PERL5LIB",buf,++idx)); else if (!old_vers) while (my_trnlnm("PERLLIB",buf,idx++)) - incpush_use_sep(buf, 0); + incpush_use_sep(buf, 0, 0); #endif /* VMS */ } @@ -4136,9 +4136,9 @@ S_init_perllib(pTHX_ U32 old_vers) */ #ifdef APPLLIB_EXP if (!old_vers) { - incpush_use_sep(APPLLIB_EXP, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); + S_incpush_use_sep(aTHX_ STR_WITH_LEN(APPLLIB_EXP), INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); } else { - incpush_use_sep(APPLLIB_EXP, old_vers|INCPUSH_CAN_RELOCATE); + S_incpush_use_sep(aTHX_ STR_WITH_LEN(APPLLIB_EXP), old_vers|INCPUSH_CAN_RELOCATE); } #endif @@ -4153,14 +4153,14 @@ S_init_perllib(pTHX_ U32 old_vers) # ifdef ARCHLIB_EXP if (!old_vers) - incpush_use_sep(ARCHLIB_EXP, INCPUSH_CAN_RELOCATE); + S_incpush_use_sep(aTHX_ STR_WITH_LEN(ARCHLIB_EXP), INCPUSH_CAN_RELOCATE); # endif Perl_sv_setpvf(aTHX_ privdir, "%slib:", macperl); if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) - incpush_use_sep(SvPVX(privdir), INCPUSH_ADD_SUB_DIRS); + incpush_use_sep(SvPVX(privdir), SvCUR(privdir), INCPUSH_ADD_SUB_DIRS); Perl_sv_setpvf(aTHX_ privdir, "%ssite_perl:", macperl); - if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) + if (PerlLIO_stat(SvPVX(privdir), SvCUR(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) incpush_use_sep(SvPVX(privdir), INCPUSH_ADD_SUB_DIRS); SvREFCNT_dec(privdir); @@ -4172,7 +4172,7 @@ S_init_perllib(pTHX_ U32 old_vers) /* sitearch is always relative to sitelib on Windows for * DLL-based path intuition to work correctly */ # if !defined(WIN32) - incpush_use_sep(SITEARCH_EXP, INCPUSH_CAN_RELOCATE); + S_incpush_use_sep(aTHX_ STR_WITH_LEN(SITEARCH_EXP), INCPUSH_CAN_RELOCATE); # endif #endif @@ -4181,16 +4181,16 @@ S_init_perllib(pTHX_ U32 old_vers) /* this picks up sitearch as well */ s = win32_get_sitelib(PERL_FS_VERSION); if (s) - incpush_use_sep(s, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); + incpush_use_sep(s, 0, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); # else - incpush_use_sep(SITELIB_EXP, INCPUSH_CAN_RELOCATE); + S_incpush_use_sep(aTHX_ STR_WITH_LEN(SITELIB_EXP), INCPUSH_CAN_RELOCATE); # endif #endif } #if defined(SITELIB_STEM) && defined(PERL_INC_VERSION_LIST) /* Search for version-specific dirs below here */ - incpush_use_sep(SITELIB_STEM, old_vers|INCPUSH_CAN_RELOCATE); + S_incpush_use_sep(aTHX_ STR_WITH_LEN(SITELIB_STEM), old_vers|INCPUSH_CAN_RELOCATE); #endif if (!old_vers) { @@ -4198,7 +4198,7 @@ S_init_perllib(pTHX_ U32 old_vers) /* vendorarch is always relative to vendorlib on Windows for * DLL-based path intuition to work correctly */ # if !defined(WIN32) - incpush_use_sep(PERL_VENDORARCH_EXP, INCPUSH_CAN_RELOCATE); + S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_VENDORARCH_EXP), INCPUSH_CAN_RELOCATE); # endif #endif @@ -4207,21 +4207,21 @@ S_init_perllib(pTHX_ U32 old_vers) /* this picks up vendorarch as well */ s = win32_get_vendorlib(PERL_FS_VERSION); if (s) - incpush_use_sep(s, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); + incpush_use_sep(s, 0, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); # else - incpush_use_sep(PERL_VENDORLIB_EXP, INCPUSH_CAN_RELOCATE); + S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_VENDORLIB_EXP), INCPUSH_CAN_RELOCATE); # endif #endif } #if defined(PERL_VENDORLIB_STEM) && defined(PERL_INC_VERSION_LIST) /* Search for version-specific dirs below here */ - incpush_use_sep(PERL_VENDORLIB_STEM, old_vers|INCPUSH_CAN_RELOCATE); + S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_VENDORLIB_STEM), old_vers|INCPUSH_CAN_RELOCATE); #endif if (!old_vers) { #ifdef ARCHLIB_EXP - incpush_use_sep(ARCHLIB_EXP, INCPUSH_CAN_RELOCATE); + S_incpush_use_sep(aTHX_ STR_WITH_LEN(ARCHLIB_EXP), INCPUSH_CAN_RELOCATE); #endif #ifndef PRIVLIB_EXP @@ -4231,18 +4231,18 @@ S_init_perllib(pTHX_ U32 old_vers) #if defined(WIN32) s = win32_get_privlib(PERL_FS_VERSION); if (s) - incpush_use_sep(s, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); + incpush_use_sep(s, 0, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); #else - incpush_use_sep(PRIVLIB_EXP, INCPUSH_CAN_RELOCATE); + S_incpush_use_sep(aTHX_ STR_WITH_LEN(PRIVLIB_EXP), INCPUSH_CAN_RELOCATE); #endif } #ifdef PERL_OTHERLIBDIRS if (!old_vers) { - incpush_use_sep(PERL_OTHERLIBDIRS, INCPUSH_ADD_SUB_DIRS + S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_OTHERLIBDIRS), INCPUSH_ADD_SUB_DIRS |INCPUSH_CAN_RELOCATE); } else { - incpush_use_sep(PERL_OTHERLIBDIRS, old_vers|INCPUSH_CAN_RELOCATE); + S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_OTHERLIBDIRS), old_vers|INCPUSH_CAN_RELOCATE); } #endif @@ -4544,33 +4544,36 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags) } STATIC void -S_incpush_use_sep(pTHX_ const char *p, U32 flags) +S_incpush_use_sep(pTHX_ const char *p, STRLEN len, U32 flags) { + const char *s; + const char *end; /* This logic has been broken out from S_incpush(). It may be possible to simplify it. */ PERL_ARGS_ASSERT_INCPUSH_USE_SEP; + if (!len) + len = strlen(p); + + end = p + len; + /* Break at all separators */ - while (*p) { - const char *s; + while ((s = memchr(p, PERLLIB_SEP, end - p))) { + if (s == p) { + /* skip any consecutive separators */ - /* skip any consecutive separators */ - while ( *p == PERLLIB_SEP ) { /* Uncomment the next line for PATH semantics */ + /* But you'll need to write tests */ /* av_push(GvAVn(PL_incgv), newSVpvs(".")); */ - p++; - } - - if ((s = strchr(p, PERLLIB_SEP)) != NULL ) { + } else { incpush(p, (STRLEN)(s - p), flags); - p = s + 1; - } - else { - incpush(p, 0, flags); - return; } + p = s + 1; } + if (p != end) + incpush(p, (STRLEN)(end - p), flags); + } void diff --git a/proto.h b/proto.h index 0fb1c33..24665c0 100644 --- a/proto.h +++ b/proto.h @@ -4760,7 +4760,7 @@ STATIC void S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp) STATIC void S_forbid_setid(pTHX_ const char flag, const bool suidscript); STATIC void S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags); -STATIC void S_incpush_use_sep(pTHX_ const char *p, U32 flags) +STATIC void S_incpush_use_sep(pTHX_ const char *p, STRLEN len, U32 flags) __attribute__nonnull__(pTHX_1); #define PERL_ARGS_ASSERT_INCPUSH_USE_SEP \ assert(p)