Don’t let gv.c:gv_try_downgrade touch PL_statgv

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

diff --git a/t/op/gv.t b/t/op/gv.t
index 2358392..8a70f31 100644 (file)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
 
 use warnings;
 
-plan( tests => 245 );
+plan( tests => 255 );
 
 # type coercion on assignment
 $foo = 'foo';
@@ -494,6 +494,14 @@ is (ref \$::{oonk}, 'GLOB', "This export does affect original");
 is (eval 'biff', "Value", "Constant has correct value");
 is (ref \$::{biff}, 'GLOB', "Symbol table has full typeglob");
 
+$::{yarrow} = [4,5,6];
+is join("-", eval "yarrow()"), '4-5-6', 'array ref as stash elem';
+is ref $::{yarrow}, "ARRAY", 'stash elem is still array ref after use';
+is join("-", eval "&yarrow"), '4-5-6', 'calling const list with &';
+is join("-", eval "&yarrow(1..10)"), '4-5-6', 'const list ignores & args';
+is prototype "yarrow", "", 'const list has "" prototype';
+is eval "yarrow", 3, 'const list in scalar cx returns length';
+
 {
     use vars qw($glook $smek $foof);
     # Check reference assignment isn't affected by the SV type (bug #38439)
@@ -516,7 +524,7 @@ is (ref \$::{biff}, 'GLOB', "Symbol table has full typeglob");
 format =
 .
 
-foreach my $value ([1,2,3], {1=>2}, *STDOUT{IO}, \&ok, *STDOUT{FORMAT}) {
+foreach my $value ({1=>2}, *STDOUT{IO}, \&ok, *STDOUT{FORMAT}) {
     # *STDOUT{IO} returns a reference to a PVIO. As it's blessed, ref returns
     # IO::Handle, which isn't what we want.
     my $type = $value;
@@ -629,6 +637,34 @@ foreach my $type (qw(integer number string)) {
        "RT #65582/#96326 anon glob stringification");
 }
 
+# Another stringification bug: Test that recursion does not cause lexical
+# handles to lose their names.
+sub r {
+    my @output;
+    @output = r($_[0]-1) if $_[0];
+    open my $fh, "TEST";
+    push @output, $$fh;
+    close $fh;
+    @output;
+}
+is join(' ', r(4)),
+  '*main::$fh *main::$fh *main::$fh *main::$fh *main::$fh',
+  'recursion does not cause lex handles to lose their names';
+
+# And sub cloning, too; not just recursion
+my $close_over_me;
+is join(' ', sub {
+    () = $close_over_me;
+    my @output;
+    @output = CORE::__SUB__->($_[0]-1) if $_[0];
+    open my $fh, "TEST";
+    push @output, $$fh;
+    close $fh;
+    @output;
+   }->(4)),
+  '*main::$fh *main::$fh *main::$fh *main::$fh *main::$fh',
+  'sub cloning does not cause lex handles to lose their names';
+
 # [perl #71254] - Assigning a glob to a variable that has a current
 # match position. (We are testing that Perl_magic_setmglob respects globs'
 # special used of SvSCREAM.)
@@ -941,6 +977,17 @@ package lrcg {
     'constants w/nulls in their names point 2 the right GVs when promoted';
 }
 
+{
+  no warnings 'io';
+  stat *{"try_downgrade"};
+  -T _;
+  $bang = $!;
+  eval "*try_downgrade if 0";
+  -T _;
+  is "$!",$bang,
+     'try_downgrade does not touch PL_statgv (last stat handle)';
+}
+
 # Look away, please.
 # This violates perl's internal structures by fiddling with stashes in a
 # way that should never happen, but perl should not start trying to free
@@ -951,6 +998,20 @@ package lrcg {
 $::{aoeuaoeuaoeaoeu} = __PACKAGE__; # cow
 () = *{"aoeuaoeuaoeaoeu"};
 
+$x = *_119051;
+$y = \&$x;
+undef $x;
+eval { &$y };
+pass "No crash due to CvGV(vivified stub) pointing to flattened glob copy";
+# Not really supported, but this should not crash either:
+$x = *_119051again;
+delete $::{_119051again};
+$::{_119051again} = $x;    # now we have a fake glob under the right name
+$y = \&$x;                 # so when this tries to look up the right GV for
+undef $::{_119051again};   # CvGV, it still gets a fake one
+eval { $y->() };
+pass "No crash due to CvGV pointing to glob copy in the stash";
+
 __END__
 Perl
 Rules