From: Ben Morrow <ben@morrow.me.uk>
Date: Mon, 5 Jan 2009 17:31:54 +0000 (+0000)
Subject: Tests for deleting stash entries.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d018fae575c7e183deffddccedc84f1f5d7ddacb;p=p5sagit%2Fp5-mst-13.2.git

Tests for deleting stash entries.
---

diff --git a/t/op/stash.t b/t/op/stash.t
index 4d8bc7c..e2f8901 100644
--- a/t/op/stash.t
+++ b/t/op/stash.t
@@ -7,7 +7,7 @@ BEGIN {
 
 BEGIN { require "./test.pl"; }
 
-plan( tests => 13 );
+plan( tests => 30 );
 
 # Used to segfault (bug #15479)
 fresh_perl_is(
@@ -58,6 +58,84 @@ ok( !eval q{ defined %schoenmaker:: }, 'works in eval("")' );
 
 # now tests with strictures
 
-use strict;
-ok( !defined %pig::, q(referencing a non-existent stash doesn't produce stricture errors) );
-ok( !exists $pig::{bodine}, q(referencing a non-existent stash element doesn't produce stricture errors) );
+{
+    use strict;
+    ok( !defined %pig::, q(referencing a non-existent stash doesn't produce stricture errors) );
+    ok( !exists $pig::{bodine}, q(referencing a non-existent stash element doesn't produce stricture errors) );
+}
+
+SKIP: {
+    eval { require B; 1 } or skip "no B", 12;
+
+    *b = \&B::svref_2object;
+    my $CVf_ANON = B::CVf_ANON();
+
+    my $sub = do {
+        package one;
+        \&{"one"};
+    };
+    delete $one::{one};
+    my $gv = b($sub)->GV;
+
+    isa_ok( $gv, "B::GV", "deleted stash entry leaves CV with valid GV");
+    is( b($sub)->CvFLAGS & $CVf_ANON, $CVf_ANON, "...and CVf_ANON set");
+    is( eval { $gv->NAME }, "__ANON__", "...and an __ANON__ name");
+    is( eval { $gv->STASH->NAME }, "one", "...but leaves stash intact");
+
+    $sub = do {
+        package two;
+        \&{"two"};
+    };
+    %two:: = ();
+    $gv = b($sub)->GV;
+
+    isa_ok( $gv, "B::GV", "cleared stash leaves CV with valid GV");
+    is( b($sub)->CvFLAGS & $CVf_ANON, $CVf_ANON, "...and CVf_ANON set");
+    is( eval { $gv->NAME }, "__ANON__", "...and an __ANON__ name");
+    is( eval { $gv->STASH->NAME }, "__ANON__", "...and an __ANON__ stash");
+
+    $sub = do {
+        package three;
+        \&{"three"};
+    };
+    undef %three::;
+    $gv = b($sub)->GV;
+
+    isa_ok( $gv, "B::GV", "undefed stash leaves CV with valid GV");
+    is( b($sub)->CvFLAGS & $CVf_ANON, $CVf_ANON, "...and CVf_ANON set");
+    is( eval { $gv->NAME }, "__ANON__", "...and an __ANON__ name");
+    is( eval { $gv->STASH->NAME }, "__ANON__", "...and an __ANON__ stash");
+
+    TODO: {
+        local $TODO = "anon CVs not accounted for yet";
+
+        $sub = do {
+            package four;
+            sub { 1 };
+        };
+        %four:: = ();
+        $gv = b($sub)->GV;
+
+        isa_ok( $gv, "B::GV", "cleared stash leaves anon CV with valid GV");
+        is( eval { $gv->STASH->NAME }, "__ANON__", "...and an __ANON__ stash");
+
+        $sub = do {
+            package five;
+            sub { 1 };
+        };
+        undef %five::;
+        $gv = b($sub)->GV;
+
+        isa_ok( $gv, "B::GV", "undefed stash leaves anon CV with valid GV");
+        is( eval { $gv->STASH->NAME }, "__ANON__", "...and an __ANON__ stash");
+    }
+    
+    # [perl #58530]
+    fresh_perl_is(
+        'sub foo { 1 }; use overload q/""/ => \&foo;' .
+            'delete $main::{foo}; bless []',
+        "",
+        {},
+        "no segfault with overload/deleted stash entry [#58530]",
+    );
+}