Re: [perl #18066] Bug in -I when path has double colons?

Message-ID: <87of9c2prs.fsf@vran.herceg.de>

With the corresponding change to embed.fnc

p4raw-id: //depot/perl@18102

diff --git a/MANIFEST b/MANIFEST
index adde27a..e5e5c90 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2658,6 +2658,7 @@ t/run/runenv.t                    Test if perl honors its environment variables.
 t/run/switcha.t                        Test the -a switch
 t/run/switches.t               Tests for the other switches
 t/run/switchF.t                        Test the -F switch
+t/run/switchI.t                        Test the -I switch
 t/run/switchn.t                        Test the -n switch
 t/run/switchp.t                        Test the -p switch
 t/run/switchPx.aux             Data for switchPx.t

diff --git a/embed.fnc b/embed.fnc
index 5090f6b..c115249 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1012,7 +1012,7 @@ s      |void   |Slab_Free      |void *op
 #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
 s      |void   |find_beginning
 s      |void   |forbid_setid   |char *
-s      |void   |incpush        |char *|int|int
+s      |void   |incpush        |char *|int|int|int
 s      |void   |init_interp
 s      |void   |init_ids
 s      |void   |init_lexer

diff --git a/embed.h b/embed.h
index f46e4be..9dde007 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -6,9 +6,12 @@
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
  *
- *  !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
- *  This file is built by embed.pl from data in embed.pl, pp.sym, intrpvar.h,
- *  perlvars.h and thrdvar.h.  Any changes made here will be lost!
+ * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
+ * This file is built by embed.pl from data in embed.fnc, embed.pl,
+ * pp.sym, intrpvar.h, perlvars.h and thrdvar.h.
+ * Any changes made here will be lost!
+ *
+ * Edit those files and run 'make regen_headers' to effect changes.
  */
 
 /* (Doing namespace management portably in C is really gross.) */
@@ -2455,7 +2458,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,c)         S_incpush(aTHX_ a,b,c)
+#define incpush(a,b,c,d)       S_incpush(aTHX_ a,b,c,d)
 #define init_interp()          S_init_interp(aTHX)
 #define init_ids()             S_init_ids(aTHX)
 #define init_lexer()           S_init_lexer(aTHX)

diff --git a/embedvar.h b/embedvar.h
index 9ab91d2..c1c77d2 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -6,10 +6,12 @@
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
  *
- *
  * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
- *  This file is built by embed.pl from data in embed.pl, pp.sym, intrpvar.h,
- *  perlvars.h and thrdvar.h.  Any changes made here will be lost!
+ * This file is built by embed.pl from data in embed.fnc, embed.pl,
+ * pp.sym, intrpvar.h, perlvars.h and thrdvar.h.
+ * Any changes made here will be lost!
+ *
+ * Edit those files and run 'make regen_headers' to effect changes.
  */
 
 /* (Doing namespace management portably in C is really gross.) */

diff --git a/global.sym b/global.sym
index 84b9b7e..3fb671a 100644 (file)
--- a/global.sym
+++ b/global.sym
@@ -1,16 +1,3 @@
-#
-#    global.sym
-#
-#    Copyright (c) 1997-2002, Larry Wall
-#
-#    You may distribute under the terms of either the GNU General Public
-#    License or the Artistic License, as specified in the README file.
-#
-# !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
-# This file is autogenerated from data in embed.pl.  Edit that file
-# and run 'make regen_headers' to effect changes.
-#
-
 perl_alloc_using
 perl_alloc
 perl_construct

diff --git a/perl.c b/perl.c
index d18b0da..a2aa4d2 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1074,7 +1074,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                char *p;
                STRLEN len = strlen(s);
                p = savepvn(s, len);
-               incpush(p, TRUE, TRUE);
+               incpush(p, TRUE, TRUE, FALSE);
                sv_catpvn(sv, "-I", 2);
                sv_catpvn(sv, p, len);
                sv_catpvn(sv, " ", 1);
@@ -2268,7 +2268,7 @@ Perl_moreswitches(pTHX_ char *s)
                    p++;
            } while (*p && *p != '-');
            e = savepvn(s, e-s);
-           incpush(e, TRUE, TRUE);
+           incpush(e, TRUE, TRUE, FALSE);
            Safefree(e);
            s = p;
            if (*s == '-')
@@ -3539,9 +3539,9 @@ S_init_perllib(pTHX)
 #ifndef VMS
        s = PerlEnv_getenv("PERL5LIB");
        if (s)
-           incpush(s, TRUE, TRUE);
+           incpush(s, TRUE, TRUE, TRUE);
        else
-           incpush(PerlEnv_getenv("PERLLIB"), FALSE, FALSE);
+           incpush(PerlEnv_getenv("PERLLIB"), FALSE, FALSE, TRUE);
 #else /* VMS */
        /* Treat PERL5?LIB as a possible search list logical name -- the
         * "natural" VMS idiom for a Unix path string.  We allow each
@@ -3550,9 +3550,9 @@ S_init_perllib(pTHX)
        char buf[256];
        int idx = 0;
        if (my_trnlnm("PERL5LIB",buf,0))
-           do { incpush(buf,TRUE,TRUE); } while (my_trnlnm("PERL5LIB",buf,++idx));
+           do { incpush(buf,TRUE,TRUE,TRUE); } while (my_trnlnm("PERL5LIB",buf,++idx));
        else
-           while (my_trnlnm("PERLLIB",buf,idx++)) incpush(buf,FALSE,FALSE);
+           while (my_trnlnm("PERLLIB",buf,idx++)) incpush(buf,FALSE,FALSE,TRUE);
 #endif /* VMS */
     }
 
@@ -3560,11 +3560,11 @@ S_init_perllib(pTHX)
     ARCHLIB PRIVLIB SITEARCH SITELIB VENDORARCH and VENDORLIB
 */
 #ifdef APPLLIB_EXP
-    incpush(APPLLIB_EXP, TRUE, TRUE);
+    incpush(APPLLIB_EXP, TRUE, TRUE, TRUE);
 #endif
 
 #ifdef ARCHLIB_EXP
-    incpush(ARCHLIB_EXP, FALSE, FALSE);
+    incpush(ARCHLIB_EXP, FALSE, FALSE, TRUE);
 #endif
 #ifdef MACOS_TRADITIONAL
     {
@@ -3577,71 +3577,72 @@ 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);
+           incpush(SvPVX(privdir), TRUE, FALSE, TRUE);
        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);
+           incpush(SvPVX(privdir), TRUE, FALSE, TRUE);
        
        SvREFCNT_dec(privdir);
     }
     if (!PL_tainting)
-       incpush(":", FALSE, FALSE);
+       incpush(":", FALSE, FALSE, TRUE);
 #else
 #ifndef PRIVLIB_EXP
 #  define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
 #endif
 #if defined(WIN32)
-    incpush(PRIVLIB_EXP, TRUE, FALSE);
+    incpush(PRIVLIB_EXP, TRUE, FALSE, TRUE);
 #else
-    incpush(PRIVLIB_EXP, FALSE, FALSE);
+    incpush(PRIVLIB_EXP, FALSE, FALSE, TRUE);
 #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);
+    incpush(SITEARCH_EXP, FALSE, FALSE, TRUE);
 #  endif
 #endif
 
 #ifdef SITELIB_EXP
 #  if defined(WIN32)
-    incpush(SITELIB_EXP, TRUE, FALSE); /* this picks up sitearch as well */
+    /* this picks up sitearch as well */
+    incpush(SITELIB_EXP, TRUE, FALSE, TRUE);
 #  else
-    incpush(SITELIB_EXP, FALSE, FALSE);
+    incpush(SITELIB_EXP, FALSE, FALSE, TRUE);
 #  endif
 #endif
 
 #ifdef SITELIB_STEM /* Search for version-specific dirs below here */
-    incpush(SITELIB_STEM, FALSE, TRUE);
+    incpush(SITELIB_STEM, FALSE, TRUE, 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, FALSE);
+    incpush(PERL_VENDORARCH_EXP, FALSE, FALSE, TRUE);
 #  endif
 #endif
 
 #ifdef PERL_VENDORLIB_EXP
 #  if defined(WIN32)
-    incpush(PERL_VENDORLIB_EXP, TRUE, FALSE);  /* this picks up vendorarch as well */
+    incpush(PERL_VENDORLIB_EXP, TRUE, FALSE, TRUE);    /* this picks up vendorarch as well */
 #  else
-    incpush(PERL_VENDORLIB_EXP, FALSE, FALSE);
+    incpush(PERL_VENDORLIB_EXP, FALSE, FALSE, TRUE);
 #  endif
 #endif
 
 #ifdef PERL_VENDORLIB_STEM /* Search for version-specific dirs below here */
-    incpush(PERL_VENDORLIB_STEM, FALSE, TRUE);
+    incpush(PERL_VENDORLIB_STEM, FALSE, TRUE, TRUE);
 #endif
 
 #ifdef PERL_OTHERLIBDIRS
-    incpush(PERL_OTHERLIBDIRS, TRUE, TRUE);
+    incpush(PERL_OTHERLIBDIRS, TRUE, TRUE, TRUE);
 #endif
 
     if (!PL_tainting)
-       incpush(".", FALSE, FALSE);
+       incpush(".", FALSE, FALSE, TRUE);
 #endif /* MACOS_TRADITIONAL */
 }
 
@@ -3663,7 +3664,7 @@ S_init_perllib(pTHX)
 #endif
 
 STATIC void
-S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers)
+S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers, int usesep)
 {
     SV *subdir = Nullsv;
 
@@ -3680,13 +3681,15 @@ S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers)
        char *s;
 
        /* skip any consecutive separators */
-       while ( *p == PERLLIB_SEP ) {
-           /* Uncomment the next line for PATH semantics */
-           /* av_push(GvAVn(PL_incgv), newSVpvn(".", 1)); */
-           p++;
+       if (usesep) {
+           while ( *p == PERLLIB_SEP ) {
+               /* Uncomment the next line for PATH semantics */
+               /* av_push(GvAVn(PL_incgv), newSVpvn(".", 1)); */
+               p++;
+           }
        }
 
-       if ( (s = strchr(p, PERLLIB_SEP)) != Nullch ) {
+       if ( usesep && (s = strchr(p, PERLLIB_SEP)) != Nullch ) {
            sv_setpvn(libdir, PERLLIB_MANGLE(p, (STRLEN)(s - p)),
                      (STRLEN)(s - p));
            p = s + 1;

diff --git a/proto.h b/proto.h
index 027cda6..475f2a1 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1,16 +1,3 @@
-/*
- *    proto.h
- *
- *    Copyright (c) 1997-2002, Larry Wall
- *
- *    You may distribute under the terms of either the GNU General Public
- *    License or the Artistic License, as specified in the README file.
- *
- * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
- * This file is autogenerated from data in embed.pl.  Edit that file
- * and run 'make regen_headers' to effect changes.
- */
-
 
 START_EXTERN_C
 
@@ -1052,7 +1039,7 @@ STATIC void       S_Slab_Free(pTHX_ void *op);
 #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, int);
+STATIC void    S_incpush(pTHX_ char *, int, int, int);
 STATIC void    S_init_interp(pTHX);
 STATIC void    S_init_ids(pTHX);
 STATIC void    S_init_lexer(pTHX);

diff --git a/t/run/runenv.t b/t/run/runenv.t
index 236f84e..317784a 100644 (file)
--- a/t/run/runenv.t
+++ b/t/run/runenv.t
@@ -16,7 +16,7 @@ BEGIN {
 
 use Test;
 
-plan tests => 11;
+plan tests => 15;
 
 my $STDOUT = './results-0';
 my $STDERR = './results-1';
@@ -145,6 +145,28 @@ try({PERL5OPT => '-t'},
     '1',
     '');
 
+try({PERLLIB => "foobar:42"},
+    ['-e', 'print grep { $_ eq "foobar" } @INC'],
+    'foobar',
+    '');
+
+try({PERLLIB => "foobar:42"},
+    ['-e', 'print grep { $_ eq "42" } @INC'],
+    '42',
+    '');
+
+try({PERL5LIB => "foobar:42"},
+    ['-e', 'print grep { $_ eq "foobar" } @INC'],
+    'foobar',
+    '');
+
+try({PERL5LIB => "foobar:42"},
+    ['-e', 'print grep { $_ eq "42" } @INC'],
+    '42',
+    '');
+
+# PERL5LIB tests with included arch directories still missing
+
 END {
     1 while unlink $STDOUT;
     1 while unlink $STDERR;

diff --git a/t/run/switchI.t b/t/run/switchI.t
new file mode 100644 (file)
index 0000000..fa74b94
--- /dev/null
+++ b/t/run/switchI.t
@@ -0,0 +1,19 @@
+#!./perl -IFoo::Bar -IBla
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+    require './test.pl';       # for which_perl() etc
+}
+
+BEGIN {
+    plan(4);
+}
+
+ok(grep { $_ eq 'Bla' } @INC);
+ok(grep { $_ eq 'Foo::Bar' } @INC);
+
+fresh_perl_is('print grep { $_ eq "Bla2" } @INC', 'Bla2',
+             { switches => ['-IBla2'] }, '-I');
+fresh_perl_is('print grep { $_ eq "Foo::Bar2" } @INC', 'Foo::Bar2',
+             { switches => ['-IFoo::Bar2'] }, '-I with colons');