This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Rework mod loading for %- and %!; fix mem leak
[perl5.git] / t / op / magic.t
index afc99c5..536b225 100644 (file)
@@ -5,7 +5,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
-    plan (tests => 187);
+    plan (tests => 192);
 }
 
 # Test that defined() returns true for magic variables created on the fly,
@@ -26,7 +26,7 @@ BEGIN {
        # avoid using any global vars here:
        if ($v =~ s/^\^(?=.)//) {
            for(substr $v, 0, 1) {
-               $_ = chr ord() - 64;
+               $_ = chr(utf8::native_to_unicode(ord($_)) - 64);
            }
        }
        SKIP:
@@ -466,6 +466,7 @@ SKIP:  {
 
     undef %Errno::;
     delete $INC{"Errno.pm"};
+    delete $::{"!"};
 
     open(FOO, "nonesuch"); # Generate ENOENT
     my %errs = %{"!"}; # Cause Errno.pm to be loaded at run-time
@@ -675,11 +676,43 @@ is ${^MPEN}, undef, '${^MPEN} starts undefined';
 # This one used to croak due to that missing break:
 is ++${^MPEN}, 1, '${^MPEN} can be incremented';
 
+{
+    no warnings 'deprecated';
+    eval { ${^E_NCODING} = 1 };
+    is $@, "", 'Setting ${^E_NCODING} does nothing';
+    $_ = ${^E_NCODING};
+    pass('can read ${^E_NCODING} without blowing up');
+    is $_, 1, '${^E_NCODING} is whatever it was set to';
+}
+
+{
+    my $warned = 0;
+    local $SIG{__WARN__} = sub { ++$warned if $_[0] =~ /Use of uninitialized value in unshift/; print "# @_"; };
+    unshift @RT12608::A::ISA, qw(RT12608::B RT12608::C);
+    is $warned, 0, '[perl #126082] unshifting onto @ISA doesn\'t trigger set magic for each item';
+}
+
+{
+    my $warned = 0;
+    local $SIG{__WARN__} = sub { ++$warned if $_[0] =~ /Use of uninitialized value in unshift/; print "# @_"; };
+
+    my $x; tie $x, 'RT12608::F';
+    unshift @RT12608::X::ISA, $x, "RT12608::Z";
+    is $warned, 0, '[perl #126082] PL_delaymagic correctly/saved restored when pushing/unshifting onto @ISA';
+
+    package RT12608::F;
+    use parent 'Tie::Scalar';
+    sub TIESCALAR { bless {}; }
+    sub FETCH { push @RT12608::G::ISA, "RT12608::H"; "RT12608::Y"; }
+}
+
 # ^^^^^^^^^ New tests go here ^^^^^^^^^
 
 SKIP: {
-    skip("%ENV manipulations fail or aren't safe on $^O", 19)
+    skip("%ENV manipulations fail or aren't safe on $^O", 20)
        if $Is_Dos;
+    skip "Win32 needs XS for env/shell tests", 20
+        if $Is_MSWin32 && is_miniperl;
 
  SKIP: {
        skip("clearing \%ENV is not safe when running under valgrind or on VMS")