From: Nicholas Clark <nick@ccl4.org>
Date: Sun, 15 Feb 2009 16:18:34 +0000 (+0000)
Subject: Loop in S_init_perllib(), only calling S_incpush*() with INCPUSH_ADD_OLD_VERS
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a26c0e281cb6068a8d148933281d8186f1eb4206;p=p5sagit%2Fp5-mst-13.2.git
Loop in S_init_perllib(), only calling S_incpush*() with INCPUSH_ADD_OLD_VERS
the second time (and only for those entries at had it). Implement the loop by
calling init_perllib() twice, to avoid a rats nest of re-indenting. Add a new
flag to S_incpush() INCPUSH_NOT_BASEDIR, to supress pushing the base directory
a second time on the secnod call.
With this change, re-ordering of @INC from version-orientated to prefix-
orientated is partly complete. ARCHLIB and PRIVLIB remain at their old place in
the @INC order.
---
diff --git a/embed.fnc b/embed.fnc
index 3922ed1..5c76901 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1479,7 +1479,7 @@ s |void |incpush_use_sep|NULLOK const char *p|U32 flags
s |void |init_interp
s |void |init_ids
s |void |init_main_stash
-s |void |init_perllib
+s |void |init_perllib |U32 old_vers
s |void |init_postdump_symbols|int argc|NN char **argv|NULLOK char **env
s |void |init_predump_symbols
rs |void |my_exit_jump
diff --git a/embed.h b/embed.h
index 19e724b..0d3cbf3 100644
--- a/embed.h
+++ b/embed.h
@@ -3631,7 +3631,7 @@
#define init_interp() S_init_interp(aTHX)
#define init_ids() S_init_ids(aTHX)
#define init_main_stash() S_init_main_stash(aTHX)
-#define init_perllib() S_init_perllib(aTHX)
+#define init_perllib(a) S_init_perllib(aTHX_ a)
#define init_postdump_symbols(a,b,c) S_init_postdump_symbols(aTHX_ a,b,c)
#define init_predump_symbols() S_init_predump_symbols(aTHX)
#define my_exit_jump() S_my_exit_jump(aTHX)
diff --git a/perl.c b/perl.c
index 9163f15..1b38f79 100644
--- a/perl.c
+++ b/perl.c
@@ -1628,6 +1628,7 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
#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
@@ -1979,7 +1980,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
TAINT;
S_set_caret_X(aTHX);
TAINT_NOT;
- init_perllib();
+ init_perllib(0);
+ init_perllib(INCPUSH_ADD_OLD_VERS|INCPUSH_NOT_BASEDIR);
{
bool suidscript = FALSE;
@@ -4090,7 +4092,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
}
STATIC void
-S_init_perllib(pTHX)
+S_init_perllib(pTHX_ U32 old_vers)
{
dVAR;
char *s;
@@ -4107,8 +4109,8 @@ S_init_perllib(pTHX)
#else
if (s)
#endif
- incpush_use_sep(s, INCPUSH_ADD_SUB_DIRS|INCPUSH_ADD_OLD_VERS);
- else
+ incpush_use_sep(s, old_vers ? old_vers : INCPUSH_ADD_SUB_DIRS);
+ else if (!old_vers)
incpush_use_sep(PerlEnv_getenv("PERLLIB"), 0);
#else /* VMS */
/* Treat PERL5?LIB as a possible search list logical name -- the
@@ -4119,9 +4121,9 @@ S_init_perllib(pTHX)
int idx = 0;
if (my_trnlnm("PERL5LIB",buf,0))
do {
- incpush_use_sep(buf, INCPUSH_ADD_SUB_DIRS|INCPUSH_ADD_OLD_VERS);
+ incpush_use_sep(buf, old_vers ? old_vers : INCPUSH_ADD_SUB_DIRS);
} while (my_trnlnm("PERL5LIB",buf,++idx));
- else
+ else if (!old_vers)
while (my_trnlnm("PERLLIB",buf,idx++))
incpush_use_sep(buf, 0);
#endif /* VMS */
@@ -4131,16 +4133,19 @@ S_init_perllib(pTHX)
ARCHLIB PRIVLIB SITEARCH SITELIB VENDORARCH and VENDORLIB
*/
#ifdef APPLLIB_EXP
- incpush_use_sep(APPLLIB_EXP,
- INCPUSH_ADD_SUB_DIRS|INCPUSH_ADD_OLD_VERS
- |INCPUSH_CAN_RELOCATE);
+ 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);
+ }
#endif
#ifdef ARCHLIB_EXP
- incpush_use_sep(ARCHLIB_EXP, INCPUSH_CAN_RELOCATE);
+ if (!old_vers)
+ incpush_use_sep(ARCHLIB_EXP, INCPUSH_CAN_RELOCATE);
#endif
+ if (!old_vers) {
#ifdef MACOS_TRADITIONAL
- {
Stat_t tmpstatbuf;
SV * privdir = newSV(0);
char * macperl = PerlEnv_getenv("MACPERL");
@@ -4156,71 +4161,78 @@ S_init_perllib(pTHX)
incpush_use_sep(SvPVX(privdir), INCPUSH_ADD_SUB_DIRS);
SvREFCNT_dec(privdir);
- }
- if (!PL_tainting)
- S_incpush(aTHX_ STR_WITH_LEN(":"), 0);
+ if (!PL_tainting)
+ S_incpush(aTHX_ STR_WITH_LEN(":"), 0);
#else
#ifndef PRIVLIB_EXP
# define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
#endif
+
#if defined(WIN32)
- incpush_use_sep(PRIVLIB_EXP, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
+ incpush_use_sep(PRIVLIB_EXP, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
#else
- incpush_use_sep(PRIVLIB_EXP, INCPUSH_CAN_RELOCATE);
+ incpush_use_sep(PRIVLIB_EXP, INCPUSH_CAN_RELOCATE);
#endif
#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);
+ incpush_use_sep(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);
+ incpush_use_sep(SITELIB_EXP, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
# else
- incpush_use_sep(SITELIB_EXP, INCPUSH_CAN_RELOCATE);
+ incpush_use_sep(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, INCPUSH_ADD_OLD_VERS|INCPUSH_CAN_RELOCATE);
+ 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);
+ incpush_use_sep(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);
+ incpush_use_sep(PERL_VENDORLIB_EXP,
+ INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
# else
- incpush_use_sep(PERL_VENDORLIB_EXP, INCPUSH_CAN_RELOCATE);
+ incpush_use_sep(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,
- INCPUSH_ADD_OLD_VERS|INCPUSH_CAN_RELOCATE);
+ incpush_use_sep(PERL_VENDORLIB_STEM, old_vers|INCPUSH_CAN_RELOCATE);
#endif
#ifdef PERL_OTHERLIBDIRS
- incpush_use_sep(PERL_OTHERLIBDIRS, INCPUSH_ADD_SUB_DIRS|INCPUSH_ADD_OLD_VERS
- |INCPUSH_CAN_RELOCATE);
+ 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);
+ }
#endif
- if (!PL_tainting)
+ /* old_vers should be true, so that this last of all. */
+ if (!PL_tainting && old_vers)
S_incpush(aTHX_ STR_WITH_LEN("."), 0);
#endif /* MACOS_TRADITIONAL */
}
@@ -4269,6 +4281,7 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
const U8 addoldvers = flags & INCPUSH_ADD_OLD_VERS;
const U8 canrelocate = flags & INCPUSH_CAN_RELOCATE;
const U8 unshift = flags & INCPUSH_UNSHIFT;
+ const U8 push_basedir = (flags & INCPUSH_NOT_BASEDIR) ? 0 : 1;
SV *subdir = NULL;
AV *inc;
@@ -4483,8 +4496,9 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
/* finally add this lib directory at the end of @INC */
if (unshift) {
U32 extra = av_len(av) + 1;
- av_unshift(inc, extra + 1);
- av_store(inc, extra, libdir);
+ 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.
@@ -4500,9 +4514,14 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
}
SvREFCNT_dec(av);
}
- else {
+ else if (push_basedir) {
av_push(inc, libdir);
}
+
+ if (!push_basedir) {
+ assert (SvREFCNT(libdir) == 1);
+ SvREFCNT_dec(libdir);
+ }
}
if (subdir) {
assert (SvREFCNT(subdir) == 1);
diff --git a/proto.h b/proto.h
index 03904d1..a2139db 100644
--- a/proto.h
+++ b/proto.h
@@ -4764,7 +4764,7 @@ STATIC void S_incpush_use_sep(pTHX_ const char *p, U32 flags);
STATIC void S_init_interp(pTHX);
STATIC void S_init_ids(pTHX);
STATIC void S_init_main_stash(pTHX);
-STATIC void S_init_perllib(pTHX);
+STATIC void S_init_perllib(pTHX_ U32 old_vers);
STATIC void S_init_postdump_symbols(pTHX_ int argc, char **argv, char **env)
__attribute__nonnull__(pTHX_2);
#define PERL_ARGS_ASSERT_INIT_POSTDUMP_SYMBOLS \