diff options
| -rw-r--r-- | embed.h | 2 | ||||
| -rwxr-xr-x | embed.pl | 2 | ||||
| -rw-r--r-- | perl.c | 99 | ||||
| -rw-r--r-- | proto.h | 2 | ||||
| -rwxr-xr-x | t/lib/fatal.t | 2 |
5 files changed, 56 insertions, 51 deletions
@@ -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) @@ -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 @@ -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 } @@ -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 c17a0a2c6f..4013fbd371 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; |