X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=7f983516e5a493c9252954238e84fdcbcfaf1cc0;hb=08d0d8ab11be611f4baf746cfb6ff7791962f494;hp=e9a40187fb4613e6fa649b7c2a1caf5023223778;hpb=e50b42d3b9d4d5466150b00299d8145beabd33df;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perl.c b/perl.c
index e9a4018..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.  */
@@ -1625,11 +1624,14 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
     return ret;
 }
 
-#define INCPUSH_ADD_SUB_DIRS	0x01
-#define INCPUSH_ADD_OLD_VERS	0x02
-#define INCPUSH_NOT_BASEDIR	0x04
-#define INCPUSH_CAN_RELOCATE	0x08
-#define INCPUSH_UNSHIFT		0x10
+#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)
@@ -1979,8 +1981,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     TAINT;
     S_set_caret_X(aTHX);
     TAINT_NOT;
-    init_perllib(0);
-    init_perllib(INCPUSH_ADD_OLD_VERS|INCPUSH_NOT_BASEDIR);
+    init_perllib();
 
     {
 	bool suidscript = FALSE;
@@ -4091,28 +4092,35 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 }
 
 STATIC void
-S_init_perllib(pTHX_ U32 old_vers)
+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_use_sep(s, old_vers ? old_vers : INCPUSH_ADD_SUB_DIRS);
-	else if (!old_vers) {
+	    incpush_use_sep(perl5lib, 0, INCPUSH_ADD_SUB_DIRS);
+	else {
 	    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 +4131,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, INCPUSH_ADD_SUB_DIRS);
 	    } while (my_trnlnm("PERL5LIB",buf,++idx));
-	else if (!old_vers)
+	else if
 	    while (my_trnlnm("PERLLIB",buf,idx++))
-		incpush_use_sep(buf, 0);
+		incpush_use_sep(buf, 0, 0);
 #endif /* VMS */
     }
 
@@ -4135,15 +4143,12 @@ S_init_perllib(pTHX_ U32 old_vers)
     ARCHLIB PRIVLIB SITEARCH SITELIB VENDORARCH and VENDORLIB
 */
 #ifdef APPLLIB_EXP
-    if (!old_vers) {
-	incpush_use_sep(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),
+		      INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
 #endif
 
-    if (!old_vers) {
 #ifdef MACOS_TRADITIONAL
+    {
 	Stat_t tmpstatbuf;
     	SV * privdir = newSV(0);
 	char * macperl = PerlEnv_getenv("MACPERL");
@@ -4152,73 +4157,66 @@ S_init_perllib(pTHX_ U32 old_vers)
 	    macperl = "";
 
 #  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))
-	    incpush_use_sep(SvPVX(privdir), INCPUSH_ADD_SUB_DIRS);
+	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);
+    }
 #else
-
 #ifdef SITEARCH_EXP
     /* 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
 
 #ifdef SITELIB_EXP
 #  if defined(WIN32)
     /* this picks up sitearch as well */
-	incpush_use_sep(SITELIB_EXP, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
+	s = win32_get_sitelib(PERL_FS_VERSION, &len);
+	if (s)
+	    incpush_use_sep(s, len, 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);
-#endif
 
-    if (!old_vers) {
 #ifdef PERL_VENDORARCH_EXP
     /* 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
 
 #ifdef PERL_VENDORLIB_EXP
 #  if defined(WIN32)
     /* this picks up vendorarch as well */
-	incpush_use_sep(PERL_VENDORLIB_EXP,
-			INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
+	s = win32_get_vendorlib(PERL_FS_VERSION, &len);
+	if (s)
+	    incpush_use_sep(s, len, 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);
-#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
@@ -4226,23 +4224,82 @@ S_init_perllib(pTHX_ U32 old_vers)
 #endif
 
 #if defined(WIN32)
-	incpush_use_sep(PRIVLIB_EXP, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
+    s = win32_get_privlib(PERL_FS_VERSION, &len);
+    if (s)
+	incpush_use_sep(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
 #else
-	incpush_use_sep(PRIVLIB_EXP, INCPUSH_CAN_RELOCATE);
+#  ifdef NETWARE
+    S_incpush_use_sep(aTHX_ PRIVLIB_EXP, 0, INCPUSH_CAN_RELOCATE);
+#  else
+    S_incpush_use_sep(aTHX_ STR_WITH_LEN(PRIVLIB_EXP), INCPUSH_CAN_RELOCATE);
+#  endif
 #endif
-    }
 
 #ifdef PERL_OTHERLIBDIRS
-    if (!old_vers) {
-	incpush_use_sep(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),
+		      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 */
+    S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_VENDORLIB_STEM),
+		      INCPUSH_ADD_OLD_VERS|INCPUSH_CAN_RELOCATE);
+#endif
+
+#ifdef PERL_OTHERLIBDIRS
+    S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_OTHERLIBDIRS),
+		      INCPUSH_ADD_OLD_VERS|INCPUSH_ADD_ARCHONLY_SUB_DIRS
+		      |INCPUSH_CAN_RELOCATE);
 #endif
 
-    /* old_vers should be true, so that this last of all.  */
-    if (!PL_tainting && old_vers)
+    if (!PL_tainting)
 	S_incpush(aTHX_ STR_WITH_LEN("."), 0);
 #endif /* MACOS_TRADITIONAL */
 }
@@ -4268,7 +4325,7 @@ S_init_perllib(pTHX_ U32 old_vers)
    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_ AV *const av, SV *dir)
+S_incpush_if_exists(pTHX_ AV *const av, SV *dir, SV *const stem)
 {
     dVAR;
     Stat_t tmpstatbuf;
@@ -4278,7 +4335,10 @@ S_incpush_if_exists(pTHX_ AV *const av, SV *dir)
     if (PerlLIO_stat(SvPVX_const(dir), &tmpstatbuf) >= 0 &&
 	S_ISDIR(tmpstatbuf.st_mode)) {
 	av_push(av, dir);
-	dir = newSV(0);
+	dir = newSVsv(stem);
+    } else {
+	/* Truncate dir back to stem.  */
+	SvCUR_set(dir, SvCUR(stem));
     }
     return dir;
 }
@@ -4287,23 +4347,24 @@ STATIC void
 S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
 {
     dVAR;
-    const U8 addsubdirs  = flags & INCPUSH_ADD_SUB_DIRS;
-    const U8 addoldvers  = flags & INCPUSH_ADD_OLD_VERS;
-    const U8 canrelocate = flags & INCPUSH_CAN_RELOCATE;
-    const U8 unshift     = flags & INCPUSH_UNSHIFT;
+    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;
-    SV *subdir = NULL;
-    AV *inc;
-
-    if (!dir || !*dir)
-	return;
-
-    inc = GvAVn(PL_incgv);
+    AV *const inc = GvAVn(PL_incgv);
 
-    if (addsubdirs || addoldvers) {
-	subdir = newSV(0);
-    }
+    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,
@@ -4313,8 +4374,7 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
 	   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
-	    = (addsubdirs || addoldvers) ? (unshift ? newAV() : inc) : NULL;
+	AV *const av = (using_sub_dirs) ? (unshift ? newAV() : inc) : NULL;
 
 	if (len) {
 	    /* I am not convinced that this is valid when PERLLIB_MANGLE is
@@ -4440,7 +4500,8 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
 	 * 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 };
@@ -4450,6 +4511,7 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
 	    char *unix;
 	    STRLEN len;
 
+
 	    if ((unix = tounixspec_ts(SvPV(libdir,len),NULL)) != NULL) {
 		len = strlen(unix);
 		while (unix[len-1] == '/') len--;  /* Cosmetic */
@@ -4460,45 +4522,50 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
 		              "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_ARCH_FMT 		"%s:"
-#define PERL_ARCH_FMT_PATH	PERL_FS_VER_FMT ""
+#define PERL_ARCH_FMT_PREFIX	""
+#define PERL_ARCH_FMT_SUFFIX	":"
+#define PERL_ARCH_FMT_PATH	PERL_FS_VERSION ""
 #else
-#define PERL_ARCH_FMT 		"/%s"
-#define PERL_ARCH_FMT_PATH	"/" 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_ av, 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_ av, subdir);
-
-		/* .../archname if -d .../archname */
-		Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT,
-			       SVfARG(libdir), ARCHNAME);
-		subdir = S_incpush_if_exists(aTHX_ av, 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_ av, 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 */
@@ -4531,40 +4598,39 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
 	    SvREFCNT_dec(libdir);
 	}
     }
-    if (subdir) {
-	assert (SvREFCNT(subdir) == 1);
-	SvREFCNT_dec(subdir);
-    }
 }
 
 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 = (const char*)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