Set %ENV keys using the same byte-string logic as setting %ENV values.

Issue #18636: This extends the work from
613c63b to %ENV keys. Previously
if you assigned an upgraded string as a key in %ENV, the string’s
internal PV representation was sent to the OS. Now the string is
“soft downgraded” before being given to the OS; if the downgrade
fails--i.e., if the string contains code points above 255--then
a warning is printed, and the string’s utf8 is assigned to the
environment, as happens with %ENV values.

A new internal macro, MgSV, is created to facilitate this work.

mg.c

@@ -1269,9 +1269,24 @@ int
 Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 {
     STRLEN len = 0, klen;
-    const char * const key = MgPV_const(mg,klen);
+
+    const char *key;
     const char *s = "";
 
+    SV *keysv = MgSV(mg);
+
+    if (keysv == NULL) {
+        key = mg->mg_ptr;
+        klen = mg->mg_len;
+    }
+    else {
+        if (!sv_utf8_downgrade(keysv, /* fail_ok */ TRUE)) {
+            Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), "Wide character in %s", "setenv key (encoding to utf8)");
+        }
+
+        key = SvPV_const(keysv,klen);
+    }
+
     PERL_ARGS_ASSERT_MAGIC_SETENV;
 
     SvGETMAGIC(sv);

mg.h

@@ -46,6 +46,15 @@ struct magic {
 #define MgTAINTEDDIR_on(mg)	(mg->mg_flags |= MGf_TAINTEDDIR)
 #define MgTAINTEDDIR_off(mg)	(mg->mg_flags &= ~MGf_TAINTEDDIR)
 
+/* Extracts the SV stored in mg, or NULL. */
+#define MgSV(mg)		(((int)((mg)->mg_len) == HEf_SVKEY) ?   \
+                                 MUTABLE_SV((mg)->mg_ptr) :	\
+                                 NULL)
+
+/* If mg contains an SV, these extract the PV stored in that SV;
+   otherwise, these extract the mg's mg_ptr/mg_len.
+   These do NOT account for the SV's UTF8 flag, so handle with care.
+*/
 #define MgPV(mg,lp)		((((int)(lp = (mg)->mg_len)) == HEf_SVKEY) ?   \
                                  SvPV(MUTABLE_SV((mg)->mg_ptr),lp) :	\
                                  (mg)->mg_ptr)

pod/perldelta.pod

@@ -211,7 +211,10 @@ XXX L<message|perldiag/"message">
 
 =item *
 
-XXX L<message|perldiag/"message">
+L<Wide character in setenv key (encoding to utf8)|perldiag/"Wide character in %s">
+
+Attempts to put wide characters into environment variable keys via C<%ENV> now
+provoke this warning.
 
 =back
 
@@ -390,7 +393,10 @@ files in F<ext/> and F<lib/> are best summarized in L</Modules and Pragmata>.
 
 =item *
 
-XXX
+Setting %ENV now properly handles upgraded strings in the key. Previously
+Perl sent the SV's internal PV directly to the OS; now it will handle keys
+as it has handled values since 5.18: attempt to downgrade the string first;
+if that fails then warn and use the utf8 form.
 
 =back
 

t/op/magic.t

@@ -5,7 +5,7 @@ BEGIN {
     chdir 't' if -d 't';
     require './test.pl';
     set_up_inc( '../lib' );
-    plan (tests => 192); # some tests are run in BEGIN block
+    plan (tests => 196); # some tests are run in BEGIN block
 }
 
 # Test that defined() returns true for magic variables created on the fly,
@@ -764,6 +764,11 @@ SKIP: {
 	$forced = $ENV{foo} = $chars;
 	ok(!utf8::is_utf8($forced) && $forced eq $bytes, 'ENV store downgrades utf8 in SV');
 	env_is(foo => $bytes, 'ENV store downgrades utf8 in setenv');
+	fail 'chars should still be wide!' if !utf8::is_utf8($chars);
+	$ENV{$chars} = 'widekey';
+	env_is("eh zero \x{A0}" => 'widekey', 'ENV store downgrades utf8 key in setenv');
+	fail 'chars should still be wide!' if !utf8::is_utf8($chars);
+	is( delete($ENV{$chars}), 'widekey', 'delete(%ENV) downgrades utf8 key' );
 
 	# warn when downgrading utf8 is not possible
 	$chars = "X-Day \x{1998}";
@@ -773,6 +778,12 @@ SKIP: {
 	  local $SIG{__WARN__} = sub { ++$warned if $_[0] =~ /^Wide character in setenv/; print "# @_" };
 	  $forced = $ENV{foo} = $chars;
 	  ok($warned == 1, 'ENV store warns about wide characters');
+
+	  fail 'chars should still be wide!' if !utf8::is_utf8($chars);
+	  $ENV{$chars} = 'widekey';
+	  env_is($forced => 'widekey', 'ENV store takes utf8-encoded key in setenv');
+
+	  ok($warned == 2, 'ENV key store warns about wide characters');
 	}
 	ok(!utf8::is_utf8($forced) && $forced eq $bytes, 'ENV store encodes high utf8 in SV');
 	env_is(foo => $bytes, 'ENV store encodes high utf8 in SV');