This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
RMG: fix typo, clarify instructions a bit
[perl5.git] / t / op / gv.t
index 5fa8d6d..2c9cc64 100644 (file)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
 
 use warnings;
 
-plan( tests => 269 );
+plan(tests => 276 );
 
 # type coercion on assignment
 $foo = 'foo';
@@ -490,6 +490,9 @@ 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';
 
+$::{borage} = \&ok;
+eval 'borage("sub ref in stash")' or fail "sub ref in stash";
+
 {
     use vars qw($glook $smek $foof);
     # Check reference assignment isn't affected by the SV type (bug #38439)
@@ -512,7 +515,7 @@ is eval "yarrow", 3, 'const list in scalar cx returns length';
 format =
 .
 
-foreach my $value ({1=>2}, *STDOUT{IO}, \&ok, *STDOUT{FORMAT}) {
+foreach my $value ({1=>2}, *STDOUT{IO}, *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;
@@ -1063,6 +1066,9 @@ is runperl(prog =>
   "Undefined subroutine &main::foo called at -e line 1.\n",
   "gv_try_downgrade does not anonymise CVs referenced elsewhere";
 
+SKIP: {
+    skip_if_miniperl("no dynamic loading on miniperl, so can't load IO::File", 4);
+
 package glob_constant_test {
   sub foo { 42 }
   use constant bar => *foo;
@@ -1070,6 +1076,28 @@ package glob_constant_test {
   ::is eval { bar->() }, eval { &{+bar} },
     'glob_constant->() is not mangled at compile time';
   ::is "$@", "", 'no error from eval { &{+glob_constant} }';
+  use constant quux => do {
+    local *F;
+    my $f = *F;
+    *$f = *STDOUT{IO};
+  };
+  ::is eval { quux->autoflush; 420 }, 420,
+    'glob_constant->method() works';
+  ::is "$@", "", 'no error from eval { glob_constant->method() }';
+}
+
+}
+
+{
+  my $free2;
+  local $SIG{__WARN__} = sub { ++$free2 if shift =~ /Attempt to free/ };
+  my $handleref;
+  my $proxy = \$handleref;
+  open $$proxy, "TEST";
+  delete $::{*$handleref{NAME}};  # delete *main::_GEN_xxx
+  undef $handleref;
+  is $free2, undef,
+    'no double free because of bad rv2gv/newGVgen refcounting';
 }
 
 # Look away, please.
@@ -1096,6 +1124,33 @@ undef $::{_119051again};   # CvGV, it still gets a fake one
 eval { $y->() };
 pass "No crash due to CvGV pointing to glob copy in the stash";
 
+# Aliasing should disable no-common-vars optimisation.
+{
+    *x = *y;
+    $x = 3;
+    ($x, my $z) = (1, $y);
+    is $z, 3, 'list assignment after aliasing [perl #89646]';
+}
+
+# RT #125840: make sure *x = $x doesn't do bad things by freeing $x before
+# it's assigned.
+
+{
+    $a_125840 = 1;
+    $b_125840 = 2;
+    $a_125840 = *b_125840;
+    *a_125840 = $a_125840;
+    is($a_125840, 2, 'RT #125840: *a = $a');
+
+    $c_125840 = 1;
+    $d_125840 = 2;
+    *d_125840 = $d_125840 = *c_125840;
+    is($d_125840, 1, 'RT #125840: *d=$d=*c');
+    $c_125840 = $d_125840;
+    is($c_125840, 1, 'RT #125840: $c=$d');
+}
+
+
 __END__
 Perl
 Rules