dVAR;
STRLEN len = 0, klen;
const char * const key = MgPV_const(mg,klen);
- const char *s = "";
+ const char *s = NULL;
PERL_ARGS_ASSERT_MAGIC_SETENV;
+ SvGETMAGIC(sv);
if (SvOK(sv)) {
- s = SvPV_const(sv,len);
- SvPOK_only(sv); /* environment variables are strings, period */
+ /* defined environment variables are byte strings; unfortunately
+ there is no SvPVbyte_force_nomg(), so we must do this piecewise */
+ (void)SvPV_force_nomg_nolen(sv);
+ sv_utf8_downgrade(sv, /* fail_ok */ TRUE);
+ if (SvUTF8(sv)) {
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), "Wide character in %s", "setenv");
+ SvUTF8_off(sv);
+ }
+ s = SvPVX(sv);
+ len = SvCUR(sv);
}
my_setenv(key, s); /* does the deed */
=head1 Incompatible Changes
-XXX For a release on a stable branch, this section aspires to be:
+[ List each incompatible change as a =head2 entry ]
- There are no changes intentionally incompatible with 5.XXX.XXX
- If any exist, they are bugs, and we request that you submit a
- report. See L</Reporting Bugs> below.
+=head2 C<$ENV{foo} = undef> deletes value from environ, like C<delete $ENV{foo}>
-[ List each incompatible change as a =head2 entry ]
+This facilitates use of C<local()> with C<%ENV> entries. In previous
+versions of Perl, C<undef> was converted to the empty string.
+
+=head2 Defined values stored in environment are forced to byte strings
+
+A value stored in an environment variable has always been stringified. In
+this release, it is converted to be only a byte string. First, it is forced
+to be a only a string. Then if the string is utf8 and the equivalent of
+C<utf8::downgrade> works, that result is used; otherwise, the equivalent of
+C<utf8::encode> is used, and a warning is issued about wide characters
+(L</Diagnostics>).
=head1 Deprecations
XXX Newly added diagnostic messages go here
+=over 4
+
+=item *
+
+Attempts to put wide characters into environment variables via %ENV provoke
+the warning "Wide character in setenv".
+
+=back
+
=head3 New Errors
=over 4
chdir 't' if -d 't';
@INC = '../lib';
require './test.pl';
- plan (tests => 156);
+ plan (tests => 171);
}
# Test that defined() returns true for magic variables created on the fly,
$Is_MSWin32 ? '.\perl' :
'./perl');
+sub env_is {
+ my ($key, $val, $desc) = @_;
+ if ($Is_MSWin32) {
+ # cmd.exe will echo 'variable=value' but 4nt will echo just the value
+ # -- Nikola Knezevic
+ like `set $key`, qr/^(?:\Q$key\E=)?\Q$val\E$/, $desc;
+ } else {
+ is `echo \$\Q$key\E`, "$val\n", $desc;
+ }
+}
+
END {
# On VMS, environment variable changes are peristent after perl exits
delete $ENV{'FOO'} if $Is_VMS;
}
}
- $ENV{__NoNeSuCh} = "foo";
- $0 = "bar";
-# cmd.exe will echo 'variable=value' but 4nt will echo just the value
-# -- Nikola Knezevic
- if ($Is_MSWin32) {
- like `set __NoNeSuCh`, qr/^(?:__NoNeSuCh=)?foo$/;
- } else {
- is `echo \$__NoNeSuCh`, "foo\n";
+ $ENV{__NoNeSuCh} = 'foo';
+ $0 = 'bar';
+ env_is(__NoNeSuCh => 'foo', 'setting $0 does not break %ENV');
+
+ # stringify a glob
+ $ENV{foo} = *TODO;
+ env_is(foo => '*main::TODO', 'ENV store of stringified glob');
+
+ # stringify a ref
+ my $ref = [];
+ $ENV{foo} = $ref;
+ env_is(foo => "$ref", 'ENV store of stringified ref');
+
+ # downgrade utf8 when possible
+ $bytes = "eh zero \x{A0}";
+ utf8::upgrade($chars = $bytes);
+ $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');
+
+ # warn when downgrading utf8 is not possible
+ $chars = "X-Day \x{1998}";
+ utf8::encode($bytes = $chars);
+ {
+ my $warned = 0;
+ 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');
}
+ 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');
+
+ # test local $ENV{foo} on existing foo
+ {
+ local $ENV{__NoNeSuCh};
+ { local $TODO = 'exists on %ENV should reflect real env';
+ ok(!exists $ENV{__NoNeSuCh}, 'not exists $ENV{existing} during local $ENV{existing}'); }
+ env_is(__NoNeLoCaL => '');
+ }
+ ok(exists $ENV{__NoNeSuCh}, 'exists $ENV{existing} after local $ENV{existing}');
+ env_is(__NoNeSuCh => 'foo');
+
+ # test local $ENV{foo} on new foo
+ {
+ local $ENV{__NoNeLoCaL} = 'foo';
+ ok(exists $ENV{__NoNeLoCaL}, 'exists $ENV{new} during local $ENV{new}');
+ env_is(__NoNeLoCaL => 'foo');
+ }
+ ok(!exists $ENV{__NoNeLoCaL}, 'not exists $ENV{new} after local $ENV{new}');
+ env_is(__NoNeLoCaL => '');
+
SKIP: {
skip("\$0 check only on Linux and FreeBSD", 2)
unless $^O =~ /^(linux|freebsd)$/