From: Gurusamy Sarathy <gsar@cpan.org>
Date: Tue, 7 Mar 2000 22:30:35 +0000 (+0000)
Subject: separate options to incpush() for adding version directories and
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9c8a64f0ac58b372989345fe3bb6251812697259;p=p5sagit%2Fp5-mst-13.2.git

separate options to incpush() for adding version directories and
architecture directories (from Andy Dougherty)

p4raw-id: //depot/perl@5601
---

diff --git a/embed.h b/embed.h
index 0906d87..3b3a836 100644
--- a/embed.h
+++ b/embed.h
@@ -2319,7 +2319,7 @@
 #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
 #define find_beginning()	S_find_beginning(aTHX)
 #define forbid_setid(a)		S_forbid_setid(aTHX_ a)
-#define incpush(a,b)		S_incpush(aTHX_ a,b)
+#define incpush(a,b,c)		S_incpush(aTHX_ a,b,c)
 #define init_interp()		S_init_interp(aTHX)
 #define init_ids()		S_init_ids(aTHX)
 #define init_lexer()		S_init_lexer(aTHX)
diff --git a/embed.pl b/embed.pl
index 56b121d..2783805 100755
--- a/embed.pl
+++ b/embed.pl
@@ -2228,7 +2228,7 @@ s	|void*	|Slab_Alloc	|int m|size_t sz
 #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
 s	|void	|find_beginning
 s	|void	|forbid_setid	|char *
-s	|void	|incpush	|char *|int
+s	|void	|incpush	|char *|int|int
 s	|void	|init_interp
 s	|void	|init_ids
 s	|void	|init_lexer
diff --git a/perl.c b/perl.c
index ccd1fe2..601c7be 100644
--- a/perl.c
+++ b/perl.c
@@ -971,7 +971,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 		char *p;
 		STRLEN len = strlen(s);
 		p = savepvn(s, len);
-		incpush(p, TRUE);
+		incpush(p, TRUE, TRUE);
 		sv_catpvn(sv, "-I", 2);
 		sv_catpvn(sv, p, len);
 		sv_catpvn(sv, " ", 1);
@@ -2062,7 +2062,7 @@ Perl_moreswitches(pTHX_ char *s)
 		    p++;
 	    } while (*p && *p != '-');
 	    e = savepvn(s, e-s);
-	    incpush(e, TRUE);
+	    incpush(e, TRUE, TRUE);
 	    Safefree(e);
 	    s = p;
 	    if (*s == '-')
@@ -3212,9 +3212,9 @@ S_init_perllib(pTHX)
 #ifndef VMS
 	s = PerlEnv_getenv("PERL5LIB");
 	if (s)
-	    incpush(s, TRUE);
+	    incpush(s, TRUE, TRUE);
 	else
-	    incpush(PerlEnv_getenv("PERLLIB"), FALSE);
+	    incpush(PerlEnv_getenv("PERLLIB"), FALSE, FALSE);
 #else /* VMS */
 	/* Treat PERL5?LIB as a possible search list logical name -- the
 	 * "natural" VMS idiom for a Unix path string.  We allow each
@@ -3223,9 +3223,9 @@ S_init_perllib(pTHX)
 	char buf[256];
 	int idx = 0;
 	if (my_trnlnm("PERL5LIB",buf,0))
-	    do { incpush(buf,TRUE); } while (my_trnlnm("PERL5LIB",buf,++idx));
+	    do { incpush(buf,TRUE,TRUE); } while (my_trnlnm("PERL5LIB",buf,++idx));
 	else
-	    while (my_trnlnm("PERLLIB",buf,idx++)) incpush(buf,FALSE);
+	    while (my_trnlnm("PERLLIB",buf,idx++)) incpush(buf,FALSE,FALSE);
 #endif /* VMS */
     }
 
@@ -3233,63 +3233,63 @@ S_init_perllib(pTHX)
     ARCHLIB PRIVLIB SITEARCH SITELIB VENDORARCH and VENDORLIB
 */
 #ifdef APPLLIB_EXP
-    incpush(APPLLIB_EXP, TRUE);
+    incpush(APPLLIB_EXP, TRUE, TRUE);
 #endif
 
 #ifdef ARCHLIB_EXP
-    incpush(ARCHLIB_EXP, FALSE);
+    incpush(ARCHLIB_EXP, FALSE, FALSE);
 #endif
 #ifndef PRIVLIB_EXP
 #  define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
 #endif
 #if defined(WIN32) 
-    incpush(PRIVLIB_EXP, TRUE);
+    incpush(PRIVLIB_EXP, TRUE, FALSE);
 #else
-    incpush(PRIVLIB_EXP, FALSE);
+    incpush(PRIVLIB_EXP, FALSE, 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);
+    incpush(SITEARCH_EXP, FALSE, FALSE);
 #  endif
 #endif
 
 #ifdef SITELIB_EXP
 #  if defined(WIN32)
-    incpush(SITELIB_EXP, TRUE);		/* this picks up sitearch as well */
+    incpush(SITELIB_EXP, TRUE, FALSE);	/* this picks up sitearch as well */
 #  else
-    incpush(SITELIB_EXP, FALSE);
+    incpush(SITELIB_EXP, FALSE, FALSE);
 #  endif
 #endif
 
 #ifdef SITELIB_STEM /* Search for version-specific dirs below here */
-    incpush(SITELIB_STEM, TRUE);
+    incpush(SITELIB_STEM, FALSE, TRUE);
 #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);
+    incpush(PERL_VENDORARCH_EXP, FALSE, FALSE);
 #  endif
 #endif
 
 #ifdef PERL_VENDORLIB_EXP
 #  if defined(WIN32)
-    incpush(PERL_VENDORLIB_EXP, TRUE);	/* this picks up vendorarch as well */
+    incpush(PERL_VENDORLIB_EXP, TRUE, FALSE);	/* this picks up vendorarch as well */
 #  else
-    incpush(PERL_VENDORLIB_EXP, FALSE);
+    incpush(PERL_VENDORLIB_EXP, FALSE, FALSE);
 #  endif
 #endif
 
 #ifdef PERL_VENDORLIB_STEM /* Search for version-specific dirs below here */
-    incpush(PERL_VENDORLIB_STEM, TRUE);
+    incpush(PERL_VENDORLIB_STEM, FALSE, TRUE);
 #endif
 
     if (!PL_tainting)
-	incpush(".", FALSE);
+	incpush(".", FALSE, FALSE);
 }
 
 #if defined(DOSISH)
@@ -3306,14 +3306,14 @@ S_init_perllib(pTHX)
 #endif 
 
 STATIC void
-S_incpush(pTHX_ char *p, int addsubdirs)
+S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers)
 {
     SV *subdir = Nullsv;
 
     if (!p || !*p)
 	return;
 
-    if (addsubdirs) {
+    if (addsubdirs || addoldvers) {
 	subdir = sv_newmortal();
     }
 
@@ -3343,7 +3343,7 @@ S_incpush(pTHX_ char *p, int addsubdirs)
 	 * BEFORE pushing libdir onto @INC we may first push version- and
 	 * archname-specific sub-directories.
 	 */
-	if (addsubdirs) {
+	if (addsubdirs || addoldvers) {
 #ifdef PERL_INC_VERSION_LIST
 	    /* Configure terminates PERL_INC_VERSION_LIST with a NULL */
 	    const char *incverlist[] = { PERL_INC_VERSION_LIST };
@@ -3364,36 +3364,41 @@ S_incpush(pTHX_ char *p, int addsubdirs)
 		              "Failed to unixify @INC element \"%s\"\n",
 			      SvPV(libdir,len));
 #endif
-	    /* .../version/archname if -d .../version/archname */
-	    Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT"/%s", libdir,
-			   (int)PERL_REVISION, (int)PERL_VERSION,
-			   (int)PERL_SUBVERSION, ARCHNAME);
-	    if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
-		  S_ISDIR(tmpstatbuf.st_mode))
-		av_push(GvAVn(PL_incgv), newSVsv(subdir));
-
-	    /* .../version if -d .../version */
-	    Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT, libdir,
-			   (int)PERL_REVISION, (int)PERL_VERSION,
-			   (int)PERL_SUBVERSION);
-	    if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
-		  S_ISDIR(tmpstatbuf.st_mode))
-		av_push(GvAVn(PL_incgv), newSVsv(subdir));
-
-	    /* .../archname if -d .../archname */
-	    Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, ARCHNAME);
-	    if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
-		  S_ISDIR(tmpstatbuf.st_mode))
-		av_push(GvAVn(PL_incgv), newSVsv(subdir));
+	    if (addsubdirs) {
+		/* .../version/archname if -d .../version/archname */
+		Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT"/%s", 
+				libdir,
+			       (int)PERL_REVISION, (int)PERL_VERSION,
+			       (int)PERL_SUBVERSION, ARCHNAME);
+		if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
+		      S_ISDIR(tmpstatbuf.st_mode))
+		    av_push(GvAVn(PL_incgv), newSVsv(subdir));
 
-#ifdef PERL_INC_VERSION_LIST
-	    for (incver = incverlist; *incver; incver++) {
-		/* .../xxx if -d .../xxx */
-		Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, *incver);
+		/* .../version if -d .../version */
+		Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT, libdir,
+			       (int)PERL_REVISION, (int)PERL_VERSION,
+			       (int)PERL_SUBVERSION);
+		if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
+		      S_ISDIR(tmpstatbuf.st_mode))
+		    av_push(GvAVn(PL_incgv), newSVsv(subdir));
+
+		/* .../archname if -d .../archname */
+		Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, ARCHNAME);
 		if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
 		      S_ISDIR(tmpstatbuf.st_mode))
 		    av_push(GvAVn(PL_incgv), newSVsv(subdir));
 	    }
+
+	    if (addoldvers) {
+#ifdef PERL_INC_VERSION_LIST
+		for (incver = incverlist; *incver; incver++) {
+		    /* .../xxx if -d .../xxx */
+		    Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, *incver);
+		    if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
+			  S_ISDIR(tmpstatbuf.st_mode))
+			av_push(GvAVn(PL_incgv), newSVsv(subdir));
+		}
+	    }
 #endif
 	}
 
diff --git a/proto.h b/proto.h
index c5a29fc..83adf58 100644
--- a/proto.h
+++ b/proto.h
@@ -1002,7 +1002,7 @@ STATIC void*	S_Slab_Alloc(pTHX_ int m, size_t sz);
 #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
 STATIC void	S_find_beginning(pTHX);
 STATIC void	S_forbid_setid(pTHX_ char *);
-STATIC void	S_incpush(pTHX_ char *, int);
+STATIC void	S_incpush(pTHX_ char *, int, int);
 STATIC void	S_init_interp(pTHX);
 STATIC void	S_init_ids(pTHX);
 STATIC void	S_init_lexer(pTHX);
diff --git a/t/lib/fatal.t b/t/lib/fatal.t
index c17a0a2..4013fbd 100755
--- a/t/lib/fatal.t
+++ b/t/lib/fatal.t
@@ -31,6 +31,6 @@ eval { opendir FOO, 'lkjqweriuapofukndajsdlfjnvcvn' };
 print "not " unless $@ =~ /^Can't open/;
 print "ok $i\n"; ++$i;
 
-eval { $a = opendir FOO, 'lkjqweriuapofukndajsdlfjnvcvn' };
+eval { my $a = opendir FOO, 'lkjqweriuapofukndajsdlfjnvcvn' };
 print "not " if $@ =~ /^Can't open/;
 print "ok $i\n"; ++$i;