X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=7f983516e5a493c9252954238e84fdcbcfaf1cc0;hb=08d0d8ab11be611f4baf746cfb6ff7791962f494;hp=f6c3931d39b202f2eb2629013bcdc6f5a81550ad;hpb=23d483e2ac9eec5dd3415b4d8aad7ec7b0551ead;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.c b/perl.c index f6c3931..7f98351 100644 --- a/perl.c +++ b/perl.c @@ -29,7 +29,6 @@ #ifdef NETWARE #include "nwutil.h" -char *nw_get_sitelib(const char *pl); #endif /* XXX If this causes problems, set i_unistd=undef in the hint file. */ @@ -347,8 +346,7 @@ perl_construct(pTHXx) PL_stashcache = newHV(); - PL_patchlevel = Perl_newSVpvf(aTHX_ "v%d.%d.%d", (int)PERL_REVISION, - (int)PERL_VERSION, (int)PERL_SUBVERSION); + PL_patchlevel = newSVpvs("v" PERL_VERSION_STRING); #ifdef HAS_MMAP if (!PL_mmap_page_size) { @@ -1626,6 +1624,15 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env) return ret; } +#define INCPUSH_UNSHIFT 0x01 +#define INCPUSH_ADD_OLD_VERS 0x02 +#define INCPUSH_ADD_VERSIONED_SUB_DIRS 0x04 +#define INCPUSH_ADD_ARCHONLY_SUB_DIRS 0x08 +#define INCPUSH_NOT_BASEDIR 0x10 +#define INCPUSH_CAN_RELOCATE 0x20 +#define INCPUSH_ADD_SUB_DIRS \ + (INCPUSH_ADD_VERSIONED_SUB_DIRS|INCPUSH_ADD_ARCHONLY_SUB_DIRS) + STATIC void * S_parse_body(pTHX_ char **env, XSINIT_t xsinit) { @@ -1742,12 +1749,10 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) } if (s && *s) { STRLEN len = strlen(s); - const char * const p = savepvn(s, len); - incpush(p, TRUE, TRUE, FALSE, FALSE, FALSE); + incpush(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_ADD_OLD_VERS); sv_catpvs(sv, "-I"); - sv_catpvn(sv, p, len); + sv_catpvn(sv, s, len); sv_catpvs(sv, " "); - Safefree(p); } else Perl_croak(aTHX_ "No directory specified for -I"); @@ -3092,9 +3097,8 @@ Perl_moreswitches(pTHX_ const char *s) while (isSPACE(*p)) p++; } while (*p && *p != '-'); - e = savepvn(s, e-s); - incpush(e, TRUE, TRUE, FALSE, FALSE, TRUE); - Safefree(e); + incpush(s, e-s, + INCPUSH_ADD_SUB_DIRS|INCPUSH_ADD_OLD_VERS|INCPUSH_UNSHIFT); s = p; if (*s == '-') s++; @@ -4091,23 +4095,33 @@ STATIC void S_init_perllib(pTHX) { dVAR; - char *s; +#ifndef VMS + const char *perl5lib = NULL; +#endif + const char *s; +#ifdef WIN32 + STRLEN len; +#endif + if (!PL_tainting) { #ifndef VMS - s = PerlEnv_getenv("PERL5LIB"); + perl5lib = PerlEnv_getenv("PERL5LIB"); /* * It isn't possible to delete an environment variable with * PERL_USE_SAFE_PUTENV set unless unsetenv() is also available, so in that * case we treat PERL5LIB as undefined if it has a zero-length value. */ #if defined(PERL_USE_SAFE_PUTENV) && ! defined(HAS_UNSETENV) - if (s && *s != '\0') + if (perl5lib && *perl5lib != '\0') #else - if (s) + if (perl5lib) #endif - incpush(s, TRUE, TRUE, TRUE, FALSE, FALSE); - else - incpush(PerlEnv_getenv("PERLLIB"), FALSE, FALSE, TRUE, FALSE, FALSE); + incpush_use_sep(perl5lib, 0, INCPUSH_ADD_SUB_DIRS); + else { + s = PerlEnv_getenv("PERLLIB"); + if (s) + incpush_use_sep(s, 0, 0); + } #else /* VMS */ /* Treat PERL5?LIB as a possible search list logical name -- the * "natural" VMS idiom for a Unix path string. We allow each @@ -4116,9 +4130,12 @@ S_init_perllib(pTHX) char buf[256]; int idx = 0; if (my_trnlnm("PERL5LIB",buf,0)) - do { incpush(buf,TRUE,TRUE,TRUE,FALSE, FALSE); } while (my_trnlnm("PERL5LIB",buf,++idx)); - else - while (my_trnlnm("PERLLIB",buf,idx++)) incpush(buf,FALSE,FALSE,TRUE,FALSE, FALSE); + do { + incpush_use_sep(buf, 0, INCPUSH_ADD_SUB_DIRS); + } while (my_trnlnm("PERL5LIB",buf,++idx)); + else if + while (my_trnlnm("PERLLIB",buf,idx++)) + incpush_use_sep(buf, 0, 0); #endif /* VMS */ } @@ -4126,12 +4143,10 @@ S_init_perllib(pTHX) ARCHLIB PRIVLIB SITEARCH SITELIB VENDORARCH and VENDORLIB */ #ifdef APPLLIB_EXP - incpush(APPLLIB_EXP, TRUE, TRUE, TRUE, TRUE, FALSE); + S_incpush_use_sep(aTHX_ STR_WITH_LEN(APPLLIB_EXP), + INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); #endif -#ifdef ARCHLIB_EXP - incpush(ARCHLIB_EXP, FALSE, FALSE, TRUE, TRUE, FALSE); -#endif #ifdef MACOS_TRADITIONAL { Stat_t tmpstatbuf; @@ -4140,77 +4155,152 @@ S_init_perllib(pTHX) if (!macperl) macperl = ""; + +# ifdef ARCHLIB_EXP + 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(SvPVX(privdir), TRUE, FALSE, TRUE, FALSE, FALSE); + 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)) - incpush(SvPVX(privdir), TRUE, FALSE, TRUE, FALSE, FALSE); + if (PerlLIO_stat(SvPVX(privdir), SvCUR(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) + incpush_use_sep(SvPVX(privdir), SvCUR(privdir), + INCPUSH_ADD_SUB_DIRS); SvREFCNT_dec(privdir); + if (!PL_tainting) + S_incpush(aTHX_ STR_WITH_LEN(":"), 0); } - if (!PL_tainting) - incpush(":", FALSE, FALSE, FALSE, FALSE, FALSE); -#else -#ifndef PRIVLIB_EXP -# define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl" -#endif -#if defined(WIN32) - incpush(PRIVLIB_EXP, TRUE, FALSE, TRUE, TRUE, FALSE); #else - incpush(PRIVLIB_EXP, FALSE, FALSE, TRUE, TRUE, FALSE); -#endif - #ifdef SITEARCH_EXP /* sitearch is always relative to sitelib on Windows for * DLL-based path intuition to work correctly */ # if !defined(WIN32) - incpush(SITEARCH_EXP, FALSE, FALSE, TRUE, TRUE, FALSE); + S_incpush_use_sep(aTHX_ STR_WITH_LEN(SITEARCH_EXP), + INCPUSH_CAN_RELOCATE); # endif #endif #ifdef SITELIB_EXP # if defined(WIN32) /* this picks up sitearch as well */ - incpush(SITELIB_EXP, TRUE, FALSE, TRUE, TRUE, FALSE); + s = win32_get_sitelib(PERL_FS_VERSION, &len); + if (s) + incpush_use_sep(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); # else - incpush(SITELIB_EXP, FALSE, FALSE, TRUE, TRUE, FALSE); + 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(SITELIB_STEM, FALSE, TRUE, TRUE, TRUE, FALSE); -#endif - #ifdef PERL_VENDORARCH_EXP /* vendorarch is always relative to vendorlib on Windows for * DLL-based path intuition to work correctly */ # if !defined(WIN32) - incpush(PERL_VENDORARCH_EXP, FALSE, FALSE, TRUE, TRUE, FALSE); + S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_VENDORARCH_EXP), + INCPUSH_CAN_RELOCATE); # endif #endif #ifdef PERL_VENDORLIB_EXP # if defined(WIN32) - incpush(PERL_VENDORLIB_EXP, TRUE, FALSE, TRUE, TRUE, FALSE); /* this picks up vendorarch as well */ + /* this picks up vendorarch as well */ + s = win32_get_vendorlib(PERL_FS_VERSION, &len); + if (s) + incpush_use_sep(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); +# else + S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_VENDORLIB_EXP), + INCPUSH_CAN_RELOCATE); +# endif +#endif + +#ifdef ARCHLIB_EXP + S_incpush_use_sep(aTHX_ STR_WITH_LEN(ARCHLIB_EXP), INCPUSH_CAN_RELOCATE); +#endif + +#ifndef PRIVLIB_EXP +# define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl" +#endif + +#if defined(WIN32) + s = win32_get_privlib(PERL_FS_VERSION, &len); + if (s) + incpush_use_sep(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); +#else +# ifdef NETWARE + S_incpush_use_sep(aTHX_ PRIVLIB_EXP, 0, INCPUSH_CAN_RELOCATE); # else - incpush(PERL_VENDORLIB_EXP, FALSE, FALSE, TRUE, TRUE, FALSE); + S_incpush_use_sep(aTHX_ STR_WITH_LEN(PRIVLIB_EXP), INCPUSH_CAN_RELOCATE); # endif #endif +#ifdef PERL_OTHERLIBDIRS + S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_OTHERLIBDIRS), + INCPUSH_ADD_VERSIONED_SUB_DIRS|INCPUSH_NOT_BASEDIR + |INCPUSH_CAN_RELOCATE); +#endif +#endif /* MACOS_TRADITIONAL */ + + if (!PL_tainting) { +#ifndef VMS +/* + * It isn't possible to delete an environment variable with + * PERL_USE_SAFE_PUTENV set unless unsetenv() is also available, so in that + * case we treat PERL5LIB as undefined if it has a zero-length value. + */ +#if defined(PERL_USE_SAFE_PUTENV) && ! defined(HAS_UNSETENV) + if (perl5lib && *perl5lib != '\0') +#else + if (perl5lib) +#endif + incpush_use_sep(perl5lib, 0, + INCPUSH_ADD_OLD_VERS|INCPUSH_NOT_BASEDIR); +#else /* VMS */ + /* Treat PERL5?LIB as a possible search list logical name -- the + * "natural" VMS idiom for a Unix path string. We allow each + * element to be a set of |-separated directories for compatibility. + */ + char buf[256]; + int idx = 0; + if (my_trnlnm("PERL5LIB",buf,0)) + do { + incpush_use_sep(buf, 0, + INCPUSH_ADD_OLD_VERS|INCPUSH_NOT_BASEDIR); + } while (my_trnlnm("PERL5LIB",buf,++idx)); +#endif /* VMS */ + } + +/* Use the ~-expanded versions of APPLLIB (undocumented), + ARCHLIB PRIVLIB SITEARCH SITELIB VENDORARCH and VENDORLIB +*/ +#ifdef APPLLIB_EXP + S_incpush_use_sep(aTHX_ STR_WITH_LEN(APPLLIB_EXP), INCPUSH_ADD_OLD_VERS + |INCPUSH_NOT_BASEDIR|INCPUSH_CAN_RELOCATE); +#endif + +#ifndef MACOS_TRADITIONAL +#if defined(SITELIB_STEM) && defined(PERL_INC_VERSION_LIST) + /* Search for version-specific dirs below here */ + S_incpush_use_sep(aTHX_ STR_WITH_LEN(SITELIB_STEM), + INCPUSH_ADD_OLD_VERS|INCPUSH_CAN_RELOCATE); +#endif + + #if defined(PERL_VENDORLIB_STEM) && defined(PERL_INC_VERSION_LIST) /* Search for version-specific dirs below here */ - incpush(PERL_VENDORLIB_STEM, FALSE, TRUE, TRUE, TRUE, FALSE); + S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_VENDORLIB_STEM), + INCPUSH_ADD_OLD_VERS|INCPUSH_CAN_RELOCATE); #endif #ifdef PERL_OTHERLIBDIRS - incpush(PERL_OTHERLIBDIRS, TRUE, TRUE, TRUE, TRUE, FALSE); + S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_OTHERLIBDIRS), + INCPUSH_ADD_OLD_VERS|INCPUSH_ADD_ARCHONLY_SUB_DIRS + |INCPUSH_CAN_RELOCATE); #endif if (!PL_tainting) - incpush(".", FALSE, FALSE, FALSE, FALSE, FALSE); + S_incpush(aTHX_ STR_WITH_LEN("."), 0); #endif /* MACOS_TRADITIONAL */ } @@ -4235,7 +4325,7 @@ S_init_perllib(pTHX) Generate a new SV if we do this, to save needing to copy the SV we push onto @INC */ STATIC SV * -S_incpush_if_exists(pTHX_ SV *dir) +S_incpush_if_exists(pTHX_ AV *const av, SV *dir, SV *const stem) { dVAR; Stat_t tmpstatbuf; @@ -4244,50 +4334,59 @@ S_incpush_if_exists(pTHX_ SV *dir) if (PerlLIO_stat(SvPVX_const(dir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) { - av_push(GvAVn(PL_incgv), dir); - dir = newSV(0); + av_push(av, dir); + dir = newSVsv(stem); + } else { + /* Truncate dir back to stem. */ + SvCUR_set(dir, SvCUR(stem)); } return dir; } STATIC void -S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep, - bool canrelocate, bool unshift) +S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags) { dVAR; - SV *subdir = NULL; - const char *p = dir; - - if (!p || !*p) - return; - - if (addsubdirs || addoldvers) { - subdir = newSV(0); - } - - /* Break at all separators */ - while (p && *p) { - SV *libdir = newSV(0); - const char *s; - - /* skip any consecutive separators */ - if (usesep) { - while ( *p == PERLLIB_SEP ) { - /* Uncomment the next line for PATH semantics */ - /* av_push(GvAVn(PL_incgv), newSVpvs(".")); */ - p++; - } + const U8 using_sub_dirs + = (U8)flags & (INCPUSH_ADD_VERSIONED_SUB_DIRS + |INCPUSH_ADD_ARCHONLY_SUB_DIRS|INCPUSH_ADD_OLD_VERS); + const U8 add_versioned_sub_dirs + = (U8)flags & INCPUSH_ADD_VERSIONED_SUB_DIRS; + const U8 add_archonly_sub_dirs + = (U8)flags & INCPUSH_ADD_ARCHONLY_SUB_DIRS; + const U8 addoldvers = (U8)flags & INCPUSH_ADD_OLD_VERS; + const U8 canrelocate = (U8)flags & INCPUSH_CAN_RELOCATE; + const U8 unshift = (U8)flags & INCPUSH_UNSHIFT; + const U8 push_basedir = (flags & INCPUSH_NOT_BASEDIR) ? 0 : 1; + AV *const inc = GvAVn(PL_incgv); + + PERL_ARGS_ASSERT_INCPUSH; + assert(len > 0); + + /* Could remove this vestigial extra block, if we don't mind a lot of + re-indenting diff noise. */ + { + SV *libdir; + /* Change 20189146be79a0596543441fa369c6bf7f85103f, to fix RT#6665, + arranged to unshift #! line -I onto the front of @INC. However, + -I can add version and architecture specific libraries, and they + need to go first. The old code assumed that it was always + pushing. Hence to make it work, need to push the architecture + (etc) libraries onto a temporary array, then "unshift" that onto + the front of @INC. */ + AV *const av = (using_sub_dirs) ? (unshift ? newAV() : inc) : NULL; + + if (len) { + /* I am not convinced that this is valid when PERLLIB_MANGLE is + defined to so something (in os2/os2.c), but the code has been + this way, ignoring any possible changed of length, since + 760ac839baf413929cd31cc32ffd6dba6b781a81 (5.003_02) so I'll leave + it be. */ + libdir = newSVpvn(PERLLIB_MANGLE(dir, len), len); + } else { + libdir = newSVpv(PERLLIB_MANGLE(dir, 0), 0); } - if ( usesep && (s = strchr(p, PERLLIB_SEP)) != NULL ) { - sv_setpvn(libdir, PERLLIB_MANGLE(p, (STRLEN)(s - p)), - (STRLEN)(s - p)); - p = s + 1; - } - else { - sv_setpv(libdir, PERLLIB_MANGLE(p, 0)); - p = NULL; /* break out */ - } #ifdef MACOS_TRADITIONAL if (!strchr(SvPVX(libdir), ':')) { char buf[256]; @@ -4401,7 +4500,8 @@ S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep, * BEFORE pushing libdir onto @INC we may first push version- and * archname-specific sub-directories. */ - if (addsubdirs || addoldvers) { + if (using_sub_dirs) { + SV *subdir; #ifdef PERL_INC_VERSION_LIST /* Configure terminates PERL_INC_VERSION_LIST with a NULL */ const char * const incverlist[] = { PERL_INC_VERSION_LIST }; @@ -4411,6 +4511,7 @@ S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep, char *unix; STRLEN len; + if ((unix = tounixspec_ts(SvPV(libdir,len),NULL)) != NULL) { len = strlen(unix); while (unix[len-1] == '/') len--; /* Cosmetic */ @@ -4421,64 +4522,116 @@ S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep, "Failed to unixify @INC element \"%s\"\n", SvPV(libdir,len)); #endif - if (addsubdirs) { + + subdir = newSVsv(libdir); + + if (add_versioned_sub_dirs) { #ifdef MACOS_TRADITIONAL -#define PERL_AV_SUFFIX_FMT "" -#define PERL_ARCH_FMT "%s:" -#define PERL_ARCH_FMT_PATH PERL_FS_VER_FMT PERL_AV_SUFFIX_FMT +#define PERL_ARCH_FMT_PREFIX "" +#define PERL_ARCH_FMT_SUFFIX ":" +#define PERL_ARCH_FMT_PATH PERL_FS_VERSION "" #else -#define PERL_AV_SUFFIX_FMT "/" -#define PERL_ARCH_FMT "/%s" -#define PERL_ARCH_FMT_PATH PERL_AV_SUFFIX_FMT PERL_FS_VER_FMT +#define PERL_ARCH_FMT_PREFIX "/" +#define PERL_ARCH_FMT_SUFFIX "" +#define PERL_ARCH_FMT_PATH "/" PERL_FS_VERSION #endif /* .../version/archname if -d .../version/archname */ - Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT_PATH PERL_ARCH_FMT, - SVfARG(libdir), - (int)PERL_REVISION, (int)PERL_VERSION, - (int)PERL_SUBVERSION, ARCHNAME); - subdir = S_incpush_if_exists(aTHX_ subdir); + sv_catpvs(subdir, PERL_ARCH_FMT_PATH \ + PERL_ARCH_FMT_PREFIX ARCHNAME PERL_ARCH_FMT_SUFFIX); + subdir = S_incpush_if_exists(aTHX_ av, subdir, libdir); /* .../version if -d .../version */ - Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT_PATH, - SVfARG(libdir), - (int)PERL_REVISION, (int)PERL_VERSION, - (int)PERL_SUBVERSION); - subdir = S_incpush_if_exists(aTHX_ subdir); - - /* .../archname if -d .../archname */ - Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT, - SVfARG(libdir), ARCHNAME); - subdir = S_incpush_if_exists(aTHX_ subdir); - + sv_catpvs(subdir, PERL_ARCH_FMT_PATH); + subdir = S_incpush_if_exists(aTHX_ av, subdir, libdir); } #ifdef PERL_INC_VERSION_LIST if (addoldvers) { for (incver = incverlist; *incver; incver++) { /* .../xxx if -d .../xxx */ - Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT, - SVfARG(libdir), *incver); - subdir = S_incpush_if_exists(aTHX_ subdir); + Perl_sv_catpvf(aTHX_ subdir, PERL_ARCH_FMT_PREFIX \ + "%s" PERL_ARCH_FMT_SUFFIX, *incver); + subdir = S_incpush_if_exists(aTHX_ av, subdir, libdir); } } #endif + + if (add_archonly_sub_dirs) { + /* .../archname if -d .../archname */ + sv_catpvs(subdir, + PERL_ARCH_FMT_PREFIX ARCHNAME PERL_ARCH_FMT_SUFFIX); + subdir = S_incpush_if_exists(aTHX_ av, subdir, libdir); + + } + + assert (SvREFCNT(subdir) == 1); + SvREFCNT_dec(subdir); } /* finally add this lib directory at the end of @INC */ if (unshift) { - av_unshift( GvAVn( PL_incgv ), 1 ); - av_store( GvAVn( PL_incgv ), 0, libdir ); + U32 extra = av_len(av) + 1; + av_unshift(inc, extra + push_basedir); + if (push_basedir) + av_store(inc, extra, libdir); + while (extra--) { + /* av owns a reference, av_store() expects to be donated a + reference, and av expects to be sane when it's cleared. + If I wanted to be naughty and wrong, I could peek inside the + implementation of av_clear(), realise that it uses + SvREFCNT_dec() too, so av's array could be a run of NULLs, + and so directly steal from it (with a memcpy() to inc, and + then memset() to NULL them out. But people copy code from the + core expecting it to be best practise, so let's use the API. + Although studious readers will note that I'm not checking any + return codes. */ + av_store(inc, extra, SvREFCNT_inc(*av_fetch(av, extra, FALSE))); + } + SvREFCNT_dec(av); } - else { - av_push(GvAVn(PL_incgv), libdir); + else if (push_basedir) { + av_push(inc, libdir); + } + + if (!push_basedir) { + assert (SvREFCNT(libdir) == 1); + SvREFCNT_dec(libdir); } - } - if (subdir) { - assert (SvREFCNT(subdir) == 1); - SvREFCNT_dec(subdir); } } +STATIC void +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 ((s = (const char*)memchr(p, PERLLIB_SEP, end - p))) { + if (s == p) { + /* skip any consecutive separators */ + + /* Uncomment the next line for PATH semantics */ + /* But you'll need to write tests */ + /* av_push(GvAVn(PL_incgv), newSVpvs(".")); */ + } else { + incpush(p, (STRLEN)(s - p), flags); + } + p = s + 1; + } + if (p != end) + incpush(p, (STRLEN)(end - p), flags); + +} void Perl_call_list(pTHX_ I32 oldscope, AV *paramList)