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 (file)
--- 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 (executable)
--- 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 (file)
--- 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 (file)
--- 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 (executable)
--- 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;