Avoid miniperl SEGVing when processing -I on the #! line
authorNicholas Clark <nick@ccl4.org>
Sat, 5 Mar 2011 18:14:47 +0000 (18:14 +0000)
committerNicholas Clark <nick@ccl4.org>
Sat, 5 Mar 2011 18:14:47 +0000 (18:14 +0000)
A side-effect of change 3185893b8dec1062 was to force av in S_incpush() to be
NULL, whilst other flag variables were still set as if it were non-NULL, for
certain cases, only when compiled with -DPERL_IS_MINIPERL

The "obvious" fix is to also set all the flag variables to 0 under
-DPERL_IS_MINIPERL, to make everything consistent. However, this confuses (at
least) the local version of gcc, which issues warnings about passing a NULL
value (av, known always to be NULL) as a not-NULL parameter, despite the fact
that all the relevant calls are inside blocks which are actually dead code,
due to the if() conditions being const variables set to 0 under
-DPERL_IS_MINIPERL.

So to avoid future bug reports about compiler warnings, the least worst thing
to do seems to be to use #ifndef to use the pre-processor to eliminate the
dead code, and related variables.

embed.fnc
embed.h
perl.c
proto.h

index 6f4f8fe..7dcb82e 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1682,7 +1682,9 @@ so        |void   |validate_suid  |NN PerlIO *rsfp
 
 s      |void*  |parse_body     |NULLOK char **env|XSINIT_t xsinit
 rs     |void   |run_body       |I32 oldscope
+#  ifndef PERL_IS_MINIPERL
 s      |SV *   |incpush_if_exists|NN AV *const av|NN SV *dir|NN SV *const stem
+#  endif
 #endif
 
 #if defined(PERL_IN_PP_C)
diff --git a/embed.h b/embed.h
index 573657e..743eb46 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define doopen_pm(a)           S_doopen_pm(aTHX_ a)
 #    endif
 #  endif
+#  if !defined(PERL_IS_MINIPERL)
+#    if defined(PERL_IN_PERL_C)
+#define incpush_if_exists(a,b,c)       S_incpush_if_exists(aTHX_ a,b,c)
+#    endif
+#  endif
 #  if !defined(PERL_NO_UTF16_FILTER)
 #    if defined(PERL_IN_TOKE_C)
 #define add_utf16_textfilter(a,b)      S_add_utf16_textfilter(aTHX_ a,b)
 #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)         S_incpush(aTHX_ a,b,c)
-#define incpush_if_exists(a,b,c)       S_incpush_if_exists(aTHX_ a,b,c)
 #define incpush_use_sep(a,b,c) S_incpush_use_sep(aTHX_ a,b,c)
 #define init_ids()             S_init_ids(aTHX)
 #define init_interp()          S_init_interp(aTHX)
diff --git a/perl.c b/perl.c
index 127c2d4..dd557af 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -4357,6 +4357,7 @@ S_init_perllib(pTHX)
 #  define PERLLIB_MANGLE(s,n) (s)
 #endif
 
+#ifndef PERL_IS_MINIPERL
 /* Push a directory onto @INC if it exists.
    Generate a new SV if we do this, to save needing to copy the SV we push
    onto @INC  */
@@ -4378,18 +4379,16 @@ S_incpush_if_exists(pTHX_ AV *const av, SV *dir, SV *const stem)
     }
     return dir;
 }
+#endif
 
 STATIC void
 S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
 {
     dVAR;
+#ifndef PERL_IS_MINIPERL
     const U8 using_sub_dirs
-#ifdef PERL_IS_MINIPERL
-        = 0;
-#else
        = (U8)flags & (INCPUSH_ADD_VERSIONED_SUB_DIRS
                       |INCPUSH_ADD_ARCHONLY_SUB_DIRS|INCPUSH_ADD_OLD_VERS);
-#endif
     const U8 add_versioned_sub_dirs
        = (U8)flags & INCPUSH_ADD_VERSIONED_SUB_DIRS;
     const U8 add_archonly_sub_dirs
@@ -4397,6 +4396,7 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
 #ifdef PERL_INC_VERSION_LIST
     const U8 addoldvers  = (U8)flags & INCPUSH_ADD_OLD_VERS;
 #endif
+#endif
     const U8 canrelocate = (U8)flags & INCPUSH_CAN_RELOCATE;
     const U8 unshift     = (U8)flags & INCPUSH_UNSHIFT;
     const U8 push_basedir = (flags & INCPUSH_NOT_BASEDIR) ? 0 : 1;
@@ -4416,7 +4416,9 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
           pushing. Hence to make it work, need to push the architecture
           (etc) libraries onto a temporary array, then "unshift" that onto
           the front of @INC.  */
+#ifndef PERL_IS_MINIPERL
        AV *const av = (using_sub_dirs) ? (unshift ? newAV() : inc) : NULL;
+#endif
 
        if (len) {
            /* I am not convinced that this is valid when PERLLIB_MANGLE is
@@ -4543,6 +4545,7 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
            }
 #endif
        }
+#ifndef PERL_IS_MINIPERL
        /*
         * BEFORE pushing libdir onto @INC we may first push version- and
         * archname-specific sub-directories.
@@ -4586,9 +4589,10 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
            assert (SvREFCNT(subdir) == 1);
            SvREFCNT_dec(subdir);
        }
-
+#endif /* !PERL_IS_MINIPERL */
        /* finally add this lib directory at the end of @INC */
        if (unshift) {
+#ifndef PERL_IS_MINIPERL
            U32 extra = av_len(av) + 1;
            av_unshift(inc, extra + push_basedir);
            if (push_basedir)
@@ -4607,6 +4611,7 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
                av_store(inc, extra, SvREFCNT_inc(*av_fetch(av, extra, FALSE)));
            }
            SvREFCNT_dec(av);
+#endif
        }
        else if (push_basedir) {
            av_push(inc, libdir);
diff --git a/proto.h b/proto.h
index b915977..80f3bc0 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -4676,6 +4676,17 @@ STATIC PerlIO *  S_doopen_pm(pTHX_ SV *name)
 
 #  endif
 #endif
+#if !defined(PERL_IS_MINIPERL)
+#  if defined(PERL_IN_PERL_C)
+STATIC SV *    S_incpush_if_exists(pTHX_ AV *const av, SV *dir, SV *const stem)
+                       __attribute__nonnull__(pTHX_1)
+                       __attribute__nonnull__(pTHX_2)
+                       __attribute__nonnull__(pTHX_3);
+#define PERL_ARGS_ASSERT_INCPUSH_IF_EXISTS     \
+       assert(av); assert(dir); assert(stem)
+
+#  endif
+#endif
 #if !defined(PERL_NO_UTF16_FILTER)
 #  if defined(PERL_IN_TOKE_C)
 STATIC U8*     S_add_utf16_textfilter(pTHX_ U8 *const s, bool reversed)
@@ -5611,13 +5622,6 @@ STATIC void      S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
 #define PERL_ARGS_ASSERT_INCPUSH       \
        assert(dir)
 
-STATIC SV *    S_incpush_if_exists(pTHX_ AV *const av, SV *dir, SV *const stem)
-                       __attribute__nonnull__(pTHX_1)
-                       __attribute__nonnull__(pTHX_2)
-                       __attribute__nonnull__(pTHX_3);
-#define PERL_ARGS_ASSERT_INCPUSH_IF_EXISTS     \
-       assert(av); assert(dir); assert(stem)
-
 STATIC void    S_incpush_use_sep(pTHX_ const char *p, STRLEN len, U32 flags)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_INCPUSH_USE_SEP       \