X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=130a83c6ec16edb2a7c0098d51d596eb5cd99de3;hb=f21000970ab9d31d61aef8d0ffdfbc9fdad80291;hp=60f8538e4503f1614e50213688d2b4881ff3a526;hpb=10cc20f60c359ae5d3303fc24a4918518974bc83;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perl.c b/perl.c
index 60f8538..130a83c 100644
--- a/perl.c
+++ b/perl.c
@@ -1642,7 +1642,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     char **argv = PL_origargv;
     const char *scriptname = NULL;
     VOL bool dosearch = FALSE;
-    register SV *sv;
     register char c;
     const char *cddir = NULL;
 #ifdef USE_SITECUSTOMIZE
@@ -1654,8 +1653,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     SvGROW(linestr_sv, 80);
     sv_setpvs(linestr_sv,"");
 
-    sv = newSVpvs("");		/* first used for -I flags */
-    SAVEFREESV(sv);
     init_main_stash();
 
     {
@@ -1750,9 +1747,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 	    if (s && *s) {
 		STRLEN len = strlen(s);
 		incpush(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_ADD_OLD_VERS);
-		sv_catpvs(sv, "-I");
-		sv_catpvn(sv, s, len);
-		sv_catpvs(sv, " ");
 	    }
 	    else
 		Perl_croak(aTHX_ "No directory specified for -I");
@@ -1929,7 +1923,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 		d = s;
 		if (!*s)
 		    break;
-		if (!strchr("CDIMUdmtw", *s))
+		if (!strchr("CDIMUdmtwW", *s))
 		    Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s);
 		while (++s && *s) {
 		    if (isSPACE(*s)) {
@@ -2034,7 +2028,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 
     boot_core_PerlIO();
     boot_core_UNIVERSAL();
-    boot_core_xsutils();
     boot_core_mro();
 
     if (xsinit)
@@ -4133,9 +4126,10 @@ S_init_perllib(pTHX)
 	    do {
 		incpush_use_sep(buf, 0, INCPUSH_ADD_SUB_DIRS);
 	    } while (my_trnlnm("PERL5LIB",buf,++idx));
-	else if
+	else {
 	    while (my_trnlnm("PERLLIB",buf,idx++))
 		incpush_use_sep(buf, 0, 0);
+	}
 #endif /* VMS */
     }
 
@@ -4325,7 +4319,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_ AV *const av, SV *dir)
+S_incpush_if_exists(pTHX_ AV *const av, SV *dir, SV *const stem)
 {
     dVAR;
     Stat_t tmpstatbuf;
@@ -4335,7 +4329,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;
 }
@@ -4351,17 +4348,19 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
 	= (U8)flags & INCPUSH_ADD_VERSIONED_SUB_DIRS;
     const U8 add_archonly_sub_dirs
 	= (U8)flags & INCPUSH_ADD_ARCHONLY_SUB_DIRS;
+#ifdef PERL_INC_VERSION_LIST
     const U8 addoldvers  = (U8)flags & INCPUSH_ADD_OLD_VERS;
+#endif
     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 *inc;
+    AV *const inc = GvAVn(PL_incgv);
 
-    if (!dir || !*dir)
-	return;
-
-    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,
@@ -4498,7 +4497,7 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
 	 * archname-specific sub-directories.
 	 */
 	if (using_sub_dirs) {
-	    SV *subdir = newSV(0);
+	    SV *subdir;
 #ifdef PERL_INC_VERSION_LIST
 	    /* Configure terminates PERL_INC_VERSION_LIST with a NULL */
 	    const char * const incverlist[] = { PERL_INC_VERSION_LIST };
@@ -4519,6 +4518,9 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
 		              "Failed to unixify @INC element \"%s\"\n",
 			      SvPV(libdir,len));
 #endif
+
+	    subdir = newSVsv(libdir);
+
 	    if (add_versioned_sub_dirs) {
 #ifdef MACOS_TRADITIONAL
 #define PERL_ARCH_FMT_PREFIX	""
@@ -4530,35 +4532,31 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
 #define PERL_ARCH_FMT_PATH	"/" PERL_FS_VERSION
 #endif
 		/* .../version/archname if -d .../version/archname */
-		sv_setsv(subdir, libdir);
 		sv_catpvs(subdir, PERL_ARCH_FMT_PATH \
 			  PERL_ARCH_FMT_PREFIX ARCHNAME PERL_ARCH_FMT_SUFFIX);
-		subdir = S_incpush_if_exists(aTHX_ av, subdir);
+		subdir = S_incpush_if_exists(aTHX_ av, subdir, libdir);
 
 		/* .../version if -d .../version */
-		sv_setsv(subdir, libdir);
 		sv_catpvs(subdir, PERL_ARCH_FMT_PATH);
-		subdir = S_incpush_if_exists(aTHX_ av, subdir);
+		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_PREFIX \
-				   "%s" PERL_ARCH_FMT_SUFFIX,
-				   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_setsv(subdir, libdir);
 		sv_catpvs(subdir,
 			  PERL_ARCH_FMT_PREFIX ARCHNAME PERL_ARCH_FMT_SUFFIX);
-		subdir = S_incpush_if_exists(aTHX_ av, subdir);
+		subdir = S_incpush_if_exists(aTHX_ av, subdir, libdir);
 
 	    }