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;