projects / p5sagit/p5-mst-13.2.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw (parent: e704978)
Better fix for bug #6665
Rafael Garcia-Suarez [Fri, 26 Dec 2008 12:12:44 +0000 (13:12 +0100)]
Add a parameter to S_incpush to indicate if the new directory should be
appended or prepended to @INC, and use it set to TRUE when parsing the
shebang line.

There is also a better version of the test.

This replaces commit ccb8f6a64f3dd06b4360bc27c194b28e6766a6ad.

embed.fnc patch | blob | blame | history
embed.h patch | blob | blame | history
perl.c patch | blob | blame | history
proto.h patch | blob | blame | history
t/run/switchI.t patch | blob | blame | history

diff --git a/embed.fnc b/embed.fnc
index 9b2a2ad..59a99ea 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1471,7 +1471,7 @@ s |void   |Slab_to_rw     |NN void *op
 #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
 s      |void   |find_beginning |NN SV* linestr_sv|NN PerlIO *rsfp
 s      |void   |forbid_setid   |const char flag|const bool suidscript
-s      |void   |incpush        |NULLOK const char *dir|bool addsubdirs|bool addoldvers|bool usesep|bool canrelocate
+s      |void   |incpush        |NULLOK const char *dir|bool addsubdirs|bool addoldvers|bool usesep|bool canrelocate|bool unshift
 s      |void   |init_interp
 s      |void   |init_ids
 s      |void   |init_main_stash
diff --git a/embed.h b/embed.h
index 1b1ee2e..a136947 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -3638,7 +3638,7 @@
 #ifdef PERL_CORE
 #define find_beginning(a,b)    S_find_beginning(aTHX_ a,b)
 #define forbid_setid(a,b)      S_forbid_setid(aTHX_ a,b)
-#define incpush(a,b,c,d,e)     S_incpush(aTHX_ a,b,c,d,e)
+#define incpush(a,b,c,d,e,f)   S_incpush(aTHX_ a,b,c,d,e,f)
 #define init_interp()          S_init_interp(aTHX)
 #define init_ids()             S_init_ids(aTHX)
 #define init_main_stash()      S_init_main_stash(aTHX)
diff --git a/perl.c b/perl.c
index 021f35d..555b0db 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1826,7 +1826,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
            if (s && *s) {
                STRLEN len = strlen(s);
                const char * const p = savepvn(s, len);
-               incpush(p, TRUE, TRUE, FALSE, FALSE);
+               incpush(p, TRUE, TRUE, FALSE, FALSE, FALSE);
                sv_catpvs(sv, "-I");
                sv_catpvn(sv, p, len);
                sv_catpvs(sv, " ");
@@ -3175,7 +3175,7 @@ Perl_moreswitches(pTHX_ const char *s)
                    p++;
            } while (*p && *p != '-');
            e = savepvn(s, e-s);
-           incpush(e, TRUE, TRUE, FALSE, FALSE);
+           incpush(e, TRUE, TRUE, FALSE, FALSE, TRUE);
            Safefree(e);
            s = p;
            if (*s == '-')
@@ -4734,9 +4734,9 @@ S_init_perllib(pTHX)
 #else
        if (s)
 #endif
-           incpush(s, TRUE, TRUE, TRUE, FALSE);
+           incpush(s, TRUE, TRUE, TRUE, FALSE, FALSE);
        else
-           incpush(PerlEnv_getenv("PERLLIB"), FALSE, FALSE, TRUE, FALSE);
+           incpush(PerlEnv_getenv("PERLLIB"), FALSE, FALSE, TRUE, 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
@@ -4745,9 +4745,9 @@ S_init_perllib(pTHX)
        char buf[256];
        int idx = 0;
        if (my_trnlnm("PERL5LIB",buf,0))
-           do { incpush(buf,TRUE,TRUE,TRUE,FALSE); } while (my_trnlnm("PERL5LIB",buf,++idx));
+           do { incpush(buf,TRUE,TRUE,TRUE,FALSE, FALSE); } while (my_trnlnm("PERL5LIB",buf,++idx));
        else
-           while (my_trnlnm("PERLLIB",buf,idx++)) incpush(buf,FALSE,FALSE,TRUE,FALSE);
+           while (my_trnlnm("PERLLIB",buf,idx++)) incpush(buf,FALSE,FALSE,TRUE,FALSE, FALSE);
 #endif /* VMS */
     }
 
@@ -4755,11 +4755,11 @@ S_init_perllib(pTHX)
     ARCHLIB PRIVLIB SITEARCH SITELIB VENDORARCH and VENDORLIB
 */
 #ifdef APPLLIB_EXP
-    incpush(APPLLIB_EXP, TRUE, TRUE, TRUE, TRUE);
+    incpush(APPLLIB_EXP, TRUE, TRUE, TRUE, TRUE, FALSE);
 #endif
 
 #ifdef ARCHLIB_EXP
-    incpush(ARCHLIB_EXP, FALSE, FALSE, TRUE, TRUE);
+    incpush(ARCHLIB_EXP, FALSE, FALSE, TRUE, TRUE, FALSE);
 #endif
 #ifdef MACOS_TRADITIONAL
     {
@@ -4772,74 +4772,74 @@ S_init_perllib(pTHX)
        
        Perl_sv_setpvf(aTHX_ privdir, "%slib:", macperl);
        if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
-           incpush(SvPVX(privdir), TRUE, FALSE, TRUE, FALSE);
+           incpush(SvPVX(privdir), TRUE, FALSE, TRUE, FALSE, FALSE);
        Perl_sv_setpvf(aTHX_ privdir, "%ssite_perl:", macperl);
        if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
-           incpush(SvPVX(privdir), TRUE, FALSE, TRUE, FALSE);
+           incpush(SvPVX(privdir), TRUE, FALSE, TRUE, FALSE, FALSE);
        
        SvREFCNT_dec(privdir);
     }
     if (!PL_tainting)
-       incpush(":", FALSE, FALSE, TRUE, FALSE);
+       incpush(":", FALSE, FALSE, TRUE, FALSE, FALSE);
 #else
 #ifndef PRIVLIB_EXP
 #  define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
 #endif
 #if defined(WIN32)
-    incpush(PRIVLIB_EXP, TRUE, FALSE, TRUE, TRUE);
+    incpush(PRIVLIB_EXP, TRUE, FALSE, TRUE, TRUE, FALSE);
 #else
-    incpush(PRIVLIB_EXP, FALSE, FALSE, TRUE, TRUE);
+    incpush(PRIVLIB_EXP, FALSE, FALSE, TRUE, TRUE, 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, FALSE, TRUE, TRUE);
+    incpush(SITEARCH_EXP, FALSE, FALSE, TRUE, TRUE, FALSE);
 #  endif
 #endif
 
 #ifdef SITELIB_EXP
 #  if defined(WIN32)
     /* this picks up sitearch as well */
-    incpush(SITELIB_EXP, TRUE, FALSE, TRUE, TRUE);
+    incpush(SITELIB_EXP, TRUE, FALSE, TRUE, TRUE, FALSE);
 #  else
-    incpush(SITELIB_EXP, FALSE, FALSE, TRUE, TRUE);
+    incpush(SITELIB_EXP, FALSE, FALSE, TRUE, TRUE, FALSE);
 #  endif
 #endif
 
 #if defined(SITELIB_STEM) && defined(PERL_INC_VERSION_LIST)
     /* Search for version-specific dirs below here */
-    incpush(SITELIB_STEM, FALSE, TRUE, TRUE, TRUE);
+    incpush(SITELIB_STEM, FALSE, TRUE, TRUE, TRUE, FALSE);
 #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, FALSE, TRUE, TRUE);
+    incpush(PERL_VENDORARCH_EXP, FALSE, FALSE, TRUE, TRUE, FALSE);
 #  endif
 #endif
 
 #ifdef PERL_VENDORLIB_EXP
 #  if defined(WIN32)
-    incpush(PERL_VENDORLIB_EXP, TRUE, FALSE, TRUE, TRUE);      /* this picks up vendorarch as well */
+    incpush(PERL_VENDORLIB_EXP, TRUE, FALSE, TRUE, TRUE, FALSE);       /* this picks up vendorarch as well */
 #  else
-    incpush(PERL_VENDORLIB_EXP, FALSE, FALSE, TRUE, TRUE);
+    incpush(PERL_VENDORLIB_EXP, FALSE, FALSE, TRUE, TRUE, FALSE);
 #  endif
 #endif
 
 #if defined(PERL_VENDORLIB_STEM) && defined(PERL_INC_VERSION_LIST)
     /* Search for version-specific dirs below here */
-    incpush(PERL_VENDORLIB_STEM, FALSE, TRUE, TRUE, TRUE);
+    incpush(PERL_VENDORLIB_STEM, FALSE, TRUE, TRUE, TRUE, FALSE);
 #endif
 
 #ifdef PERL_OTHERLIBDIRS
-    incpush(PERL_OTHERLIBDIRS, TRUE, TRUE, TRUE, TRUE);
+    incpush(PERL_OTHERLIBDIRS, TRUE, TRUE, TRUE, TRUE, FALSE);
 #endif
 
     if (!PL_tainting)
-       incpush(".", FALSE, FALSE, TRUE, FALSE);
+       incpush(".", FALSE, FALSE, TRUE, FALSE, FALSE);
 #endif /* MACOS_TRADITIONAL */
 }
 
@@ -4881,7 +4881,7 @@ S_incpush_if_exists(pTHX_ SV *dir)
 
 STATIC void
 S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep,
-         bool canrelocate)
+         bool canrelocate, bool unshift)
 {
     dVAR;
     SV *subdir = NULL;
@@ -5093,8 +5093,14 @@ S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep,
 #endif
        }
 
-       /* finally push this lib directory on the end of @INC */
-       av_push(GvAVn(PL_incgv), libdir);
+       /* finally add this lib directory at the end of @INC */
+       if (unshift) {
+           av_unshift( GvAVn( PL_incgv ), 1 );
+           av_store( GvAVn( PL_incgv ), 0, libdir );
+       }
+       else {
+           av_push(GvAVn(PL_incgv), libdir);
+       }
     }
     if (subdir) {
        assert (SvREFCNT(subdir) == 1);
diff --git a/proto.h b/proto.h
index f152635..3ec32c5 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -4753,7 +4753,7 @@ STATIC void       S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp)
        assert(linestr_sv); assert(rsfp)
 
 STATIC void    S_forbid_setid(pTHX_ const char flag, const bool suidscript);
-STATIC void    S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep, bool canrelocate);
+STATIC void    S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep, bool canrelocate, bool unshift);
 STATIC void    S_init_interp(pTHX);
 STATIC void    S_init_ids(pTHX);
 STATIC void    S_init_main_stash(pTHX);
diff --git a/t/run/switchI.t b/t/run/switchI.t
index 41192cd..398f816 100644 (file)
--- a/t/run/switchI.t
+++ b/t/run/switchI.t
@@ -15,15 +15,15 @@ my $Is_VMS   = $^O eq 'VMS';
 my $lib;
 
 $lib = $Is_MacOS ? ':Bla:' : 'Bla';
-ok(grep { $_ eq $lib } @INC);
+ok(grep { $_ eq $lib } @INC[0..($#INC-1)]);
 SKIP: {
   skip 'Double colons not allowed in dir spec', 1 if $Is_VMS;
   $lib = $Is_MacOS ? 'Foo::Bar:' : 'Foo::Bar';
-  ok(grep { $_ eq $lib } @INC);
+  ok(grep { $_ eq $lib } @INC[0..($#INC-1)]);
 }
 
 $lib = $Is_MacOS ? ':Bla2:' : 'Bla2';
-fresh_perl_is("print grep { \$_ eq '$lib' } \@INC", $lib,
+fresh_perl_is("print grep { \$_ eq '$lib' } \@INC[0..(\$#INC-1)]", $lib,
              { switches => ['-IBla2'] }, '-I');
 SKIP: {
   skip 'Double colons not allowed in dir spec', 1 if $Is_VMS;
Unnamed repository; edit this file to name it for gitweb.