handle freed backref array in global cleanup

[perl5.git] / t / op / ref.t

diff --git a/t/op/ref.t b/t/op/ref.t
index 83b5cb8..ea5bd2e 100644 (file)
--- a/t/op/ref.t
+++ b/t/op/ref.t
@@ -7,9 +7,8 @@ BEGIN {
 }
 
 use strict qw(refs subs);
-use re ();
 
-plan(200);
+plan(217);
 
 # Test glob operations.
 
@@ -136,7 +135,9 @@ sub mysub2 { lc shift }
 
 # Test REGEXP assignment
 
-{
+SKIP: {
+    skip_if_miniperl("no dynamic loading on miniperl, so can't load re", 5);
+    require re;
     my $x = qr/x/;
     my $str = "$x"; # regex stringification may change
 
@@ -379,21 +380,22 @@ curr_test($test + 2);
 # test that DESTROY is called on all objects during global destruction,
 # even those without hard references [perl #36347]
 
+$TODO = 'bug #36347';
 is(
   runperl(
-   stderr => 1, prog => 'sub DESTROY { print q-aaa- } bless \$a[0]'
+   stderr => 1, prog => 'sub DESTROY { print qq-aaa\n- } bless \$a[0]'
   ),
- "aaa", 'DESTROY called on array elem'
+ "aaa\n", 'DESTROY called on array elem'
 );
 is(
   runperl(
    stderr => 1,
-   prog => '{ bless \my@x; *a=sub{@x}}sub DESTROY { print q-aaa- }'
+   prog => '{ bless \my@x; *a=sub{@x}}sub DESTROY { print qq-aaa\n- }'
   ),
- "aaa",
+ "aaa\n",
  'DESTROY called on closure variable'
 );
-
+$TODO = undef;
 
 # test if refgen behaves with autoviv magic
 {
@@ -659,7 +661,7 @@ is( runperl(stderr => 1, prog => 'my $i;for $i (1) { for $i (2) { } }'), "");
 #    GV => blessed(AV) => RV => GV => blessed(SV)
 # all with a refcnt of 1, and hope that the second GV gets processed first
 # by do_clean_named_objs.  Then when the first GV is processed, it mustn't
-# find anything nastly left by the previous GV processing.
+# find anything nasty left by the previous GV processing.
 # The eval is stop things in the main body of the code holding a reference
 # to a GV, and the print at the end seems to bee necessary to ensure
 # the correct freeing order of *x and *y (no, I don't know why - DAPM).
@@ -671,6 +673,80 @@ is (runperl(
     "ok\n", 'freeing freed glob in global destruction');
 
 
+# Test undefined hash references as arguments to %{} in boolean context
+# [perl #81750]
+{
+ no strict 'refs';
+ eval { my $foo; %$foo;             }; ok !$@, '%$undef';
+ eval { my $foo; scalar %$foo;      }; ok !$@, 'scalar %$undef';
+ eval { my $foo; !%$foo;            }; ok !$@, '!%$undef';
+ eval { my $foo; if ( %$foo) {}     }; ok !$@, 'if ( %$undef) {}';
+ eval { my $foo; if (!%$foo) {}     }; ok !$@, 'if (!%$undef) {}';
+ eval { my $foo; unless ( %$foo) {} }; ok !$@, 'unless ( %$undef) {}';
+ eval { my $foo; unless (!%$foo) {} }; ok !$@, 'unless (!%$undef) {}';
+ eval { my $foo; 1 if %$foo;        }; ok !$@, '1 if %$undef';
+ eval { my $foo; 1 if !%$foo;       }; ok !$@, '1 if !%$undef';
+ eval { my $foo; 1 unless %$foo;    }; ok !$@, '1 unless %$undef;';
+ eval { my $foo; 1 unless ! %$foo;  }; ok !$@, '1 unless ! %$undef';
+ eval { my $foo;  %$foo ? 1 : 0;    }; ok !$@, ' %$undef ? 1 : 0';
+ eval { my $foo; !%$foo ? 1 : 0;    }; ok !$@, '!%$undef ? 1 : 0';
+}
+
+# RT #88330
+# Make sure that a leaked thinggy with multiple weak references to
+# it doesn't trigger a panic with multiple rounds of global cleanup
+# (Perl_sv_clean_all).
+
+SKIP: {
+    skip_if_miniperl('no Scalar::Util under miniperl', 4);
+
+    local $ENV{PERL_DESTRUCT_LEVEL} = 2;
+
+    # we do all permutations of array/hash, 1ref/2ref, to account
+    # for the different way backref magic is stored
+
+    fresh_perl_is(<<'EOF', 'ok', { stderr => 1 }, 'array with 1 weak ref');
+use Scalar::Util qw(weaken);
+my $r = [];
+Internals::SvREFCNT(@$r, 9);
+my $r1 = $r;
+weaken($r1);
+print "ok";
+EOF
+
+    fresh_perl_is(<<'EOF', 'ok', { stderr => 1 }, 'array with 2 weak refs');
+use Scalar::Util qw(weaken);
+my $r = [];
+Internals::SvREFCNT(@$r, 9);
+my $r1 = $r;
+weaken($r1);
+my $r2 = $r;
+weaken($r2);
+print "ok";
+EOF
+
+    fresh_perl_is(<<'EOF', 'ok', { stderr => 1 }, 'hash with 1 weak ref');
+use Scalar::Util qw(weaken);
+my $r = {};
+Internals::SvREFCNT(%$r, 9);
+my $r1 = $r;
+weaken($r1);
+print "ok";
+EOF
+
+    fresh_perl_is(<<'EOF', 'ok', { stderr => 1 }, 'hash with 2 weak refs');
+use Scalar::Util qw(weaken);
+my $r = {};
+Internals::SvREFCNT(%$r, 9);
+my $r1 = $r;
+weaken($r1);
+my $r2 = $r;
+weaken($r2);
+print "ok";
+EOF
+
+}
+
 # Bit of a hack to make test.pl happy. There are 3 more tests after it leaves.
 $test = curr_test();
 curr_test($test + 3);