Make encoding pragma lexical in scope

The encoding pragma is deprecated, but in the meantime it causes spooky
action at a distance with other modules that it may be combined with.
In these modules, operations such as chr(), ord(), and utf8::upgrade()
will suddenly start doing the wrong thing.

The documentation for 'encoding' has said to call it after loading other
modules, but this may be impractical.  This is especially bad with
anything that auto-loads at first use, like \N{} does now for charnames.

There is an issue with combining this with setting the variable
${^ENCODING} directly.  The potential for conflicts has always been
there, and remains.  This commit introduces a shadow hidden variable,
subservient to ${^ENCODING} (to preserve backwards compatibility) that
has lexical scope validity.

The pod for 'encoding' has been revamped to be more concise, clear, use
more idiomatic English, and to speak from a modern perspective.

1 files changed, 60 insertions, 4 deletions

diff --git a/mg.c b/mg.c
index 223461e7a2..27799abf3a 100644
--- a/mg.c
+++ b/mg.c
@@ -770,9 +770,40 @@ S_fixup_errno_string(pTHX_ SV* sv)
 SV*
 Perl__get_encoding(pTHX)
 {
-    /* Returns the $^ENCODING or 'use encoding' in effect; NULL if none */
+    /* 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 */
+
+    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 PL_encoding;
+    return NULL;
 }
 
 #ifdef VMS
@@ -824,6 +855,9 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	break;
     case '\005':  /* ^E */
 	 if (nextchar != '\0') {
+            /* We shouldn't be trying to retrieve this shadow variable */
+            assert(strNE(remaining, "_NCODING"));
+
             if (strEQ(remaining, "NCODING"))
                 sv_setsv(sv, _get_encoding());
             break;
@@ -2609,7 +2643,27 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 #  endif
 #endif
 	}
-	else if (strEQ(mg->mg_ptr+1, "NCODING")) {
+	else {
+            unsigned int offset = 1;
+            bool lex = FALSE;
+
+            /* It may be the shadow variable ${E_NCODING} which has lexical
+             * scope.  See comments at Perl__get_encoding in this file */
+            if (*(mg->mg_ptr + 1) == '_') {
+                lex = TRUE;
+                offset++;
+            }
+            if (strEQ(mg->mg_ptr + offset, "NCODING")) {
+                if (lex) {  /* Use the shadow global */
+                    SvREFCNT_dec(PL_lex_encoding);
+                    if (SvOK(sv) || SvGMAGICAL(sv)) {
+                        PL_lex_encoding = newSVsv(sv);
+                    }
+                    else {
+                        PL_lex_encoding = NULL;
+                    }
+                }
+                else { /* Use the regular global */
 	    SvREFCNT_dec(PL_encoding);
 	    if (SvOK(sv) || SvGMAGICAL(sv)) {
 		PL_encoding = newSVsv(sv);
@@ -2617,7 +2671,9 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	    else {
 		PL_encoding = NULL;
 	    }
-	}
+            }
+            }
+        }
 	break;
     case '\006':	/* ^F */
 	PL_maxsysfd = SvIV(sv);