dist/Data-Dumper: switch to using SvPVCLEAR()

[perl5.git] / mg.c

diff --git a/mg.c b/mg.c
index a89916d..863b5fc 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -758,7 +758,7 @@ S_fixup_errno_string(pTHX_ SV* sv)
          * error message text.  (If it turns out to be necessary, we could also
          * keep track if the current LC_MESSAGES locale is UTF-8) */
         if (! IN_BYTES  /* respect 'use bytes' */
-            && ! is_invariant_string((U8*) SvPVX_const(sv), SvCUR(sv))
+            && ! is_utf8_invariant_string((U8*) SvPVX_const(sv), SvCUR(sv))
             && is_utf8_string((U8*) SvPVX_const(sv), SvCUR(sv)))
         {
             SvUTF8_on(sv);
@@ -766,46 +766,6 @@ S_fixup_errno_string(pTHX_ SV* sv)
     }
 }
 
-SV*
-Perl__get_encoding(pTHX)
-{
-    /* For core Perl use only: Returns the $^ENCODING or 'use encoding' in
-     * effect; NULL if none.
-     *
-     * $^ENCODING maps to PL_encoding, and is the old way to do things, and is
-     * retained for backwards compatibility.  Now, there is a shadow variable
-     * ${^E_NCODING} set only by the encoding pragma, used to give this pragma
-     * lexical scope, unlike the global scope it (shudder) used to have.  This
-     * variable maps to PL_lex_encoding.  Again for backwards compatibility,
-     * PL_encoding has precedence over PL_lex_encoding.  The hints hash is used
-     * to determine if PL_lex_encoding is in scope, and hence valid.  The hints
-     * hash only accepts simple values, so we can't put an Encode object into
-     * it, so we put the object into the global, and put a simple boolean into
-     * the hints hash giving whether the global is valid or not */
-
-    dVAR;
-    SV *is_encoding;
-
-    if (PL_encoding) {
-        return PL_encoding;
-    }
-
-    if (! PL_lex_encoding) {
-        return NULL;
-    }
-
-    is_encoding = cop_hints_fetch_pvs(PL_curcop, "encoding", 0);
-    if (   is_encoding
-        && is_encoding != &PL_sv_placeholder
-        && SvIOK(is_encoding)
-        && SvIV(is_encoding))  /* non-zero mean valid */
-    {
-        return PL_lex_encoding;
-    }
-
-    return NULL;
-}
-
 #ifdef VMS
 #include <descrip.h>
 #include <starlet.h>
@@ -1248,21 +1208,26 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
        if (s && klen == 4 && strEQ(key,"PATH")) {
            const char * const strend = s + len;
 
+            /* set MGf_TAINTEDDIR if any component of the new path is
+             * relative or world-writeable */
            while (s < strend) {
                char tmpbuf[256];
                Stat_t st;
                I32 i;
-#ifdef VMS  /* Hmm.  How do we get $Config{path_sep} from C? */
-               const char path_sep = '|';
+#ifdef __VMS  /* Hmm.  How do we get $Config{path_sep} from C? */
+               const char path_sep = PL_perllib_sep;
 #else
                const char path_sep = ':';
 #endif
-               s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf,
+               s = delimcpy_no_escape(tmpbuf, tmpbuf + sizeof tmpbuf,
                             s, strend, path_sep, &i);
                s++;
                if (i >= (I32)sizeof tmpbuf   /* too long -- assume the worst */
-#ifdef VMS
-                     || !strchr(tmpbuf, ':') /* no colon thus no device name -- assume relative path */
+#ifdef __VMS
+                     /* no colon thus no device name -- assume relative path */
+                     || (PL_perllib_sep != ':' && !strchr(tmpbuf, ':'))
+                     /* Using Unix separator, e.g. under bash, so act line Unix */
+                     || (PL_perllib_sep == ':' && *tmpbuf != '/')
 #else
                      || *tmpbuf != '/'       /* no starting slash -- assume relative path */
 #endif