Add a new test for undef and delete on stash entries that

are bound to subroutines or methods. Based on a test by
Robert 'phaylon' Sedlacek.

p4raw-id: //depot/perl@30388

diff --git a/MANIFEST b/MANIFEST
index 1240c41..8e0559f 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3643,6 +3643,7 @@ t/op/substT.t                     See if substitution works with -T
 t/op/subst_wamp.t              See if substitution works with $& present
 t/op/sub.t                     See if subroutines work
 t/op/switch.t                  See if switches (given/when) work
+t/op/symbolcache.t             See if undef/delete works on stashes with functions
 t/op/sysio.t                   See if sysread and syswrite work
 t/op/taint.t                   See if tainting works
 t/op/threads_create.pl         Ancillary file for t/op/threads.t

diff --git a/t/op/symbolcache.t b/t/op/symbolcache.t
new file mode 100644 (file)
index 0000000..b3e567b
--- /dev/null
+++ b/t/op/symbolcache.t
@@ -0,0 +1,42 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+    plan( tests => 8 );
+}
+
+use strict;
+
+# first, with delete
+# simple removal
+sub removed { 23 }
+sub bound { removed() }
+delete $main::{removed};
+is( bound(), 23, 'function still bound' );
+ok( !main->can('removed'), 'function not available as method' );
+
+# replacement
+sub replaced { 'func' }
+is( replaced(), 'func', 'original function still bound' );
+is( main->replaced, 'meth', 'method is replaced function' );
+BEGIN { delete $main::{replaced} }
+sub replaced { 'meth' }
+
+# and now with undef
+# simple removal
+sub removed2 { 24 }
+sub bound2 { removed2() }
+undef $main::{removed2};
+eval { bound2() };
+like( $@, qr/Undefined subroutine &main::removed2 called/,
+    'function not bound' );
+ok( !main->can('removed2'), 'function not available as method' );
+
+# replacement
+sub replaced2 { 'func' }
+is( replaced2(), 'meth', 'original function not bound, was replaced' );
+ok( main->replaced2 eq 'meth', 'method is replaced function' );
+BEGIN { undef $main::{replaced2} }
+sub replaced2 { 'meth' }