X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/4e3a83657baae9e603058d075ecfcec051d04c5a..17a3df4c6a07533e2c03c46fdd27e3ee295d61d0:/t/op/gv.t?ds=sidebyside

diff --git a/t/op/gv.t b/t/op/gv.t
index 32afdff..c1d5f83 100644
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
 
 use warnings;
 
-plan( tests => 219 );
+plan( tests => 231 );
 
 # type coersion on assignment
 $foo = 'foo';
@@ -32,6 +32,34 @@ is(ref(\$foo), 'GLOB');
 is($foo, '*main::bar');
 is(ref(\$foo), 'GLOB');
 
+{
+ no warnings;
+ ${\*$foo} = undef;
+ is(ref(\$foo), 'GLOB', 'no type coersion when assigning to *{} retval');
+ $::{phake} = *bar;
+ is(
+   \$::{phake}, \*{"phake"},
+   'symbolic *{} returns symtab entry when FAKE'
+ );
+ ${\*{"phake"}} = undef;
+ is(
+   ref(\$::{phake}), 'GLOB',
+  'no type coersion when assigning to retval of symbolic *{}'
+ );
+ $::{phaque} = *bar;
+ eval '
+   is(
+     \$::{phaque}, \*phaque,
+     "compile-time *{} returns symtab entry when FAKE"
+   );
+   ${\*phaque} = undef;
+ ';
+ is(
+   ref(\$::{phaque}), 'GLOB',
+  'no type coersion when assigning to retval of compile-time *{}'
+ );
+}
+
 # type coersion on substitutions that match
 $a = *main::foo;
 $b = $a;
@@ -338,7 +366,7 @@ is (ref $::{ga_shloip}, 'SCALAR', "Export of proxy constant as is");
 is (ref $::{oonk}, 'SCALAR', "Export doesn't affect original");
 is (eval 'ga_shloip', "Value", "Constant has correct value");
 is (ref $::{ga_shloip}, 'SCALAR',
-    "Inlining of constant doesn't change represenatation");
+    "Inlining of constant doesn't change representation");
 
 delete $::{ga_shloip};
 
@@ -538,7 +566,7 @@ foreach my $value ([1,2,3], {1=>2}, *STDOUT{IO}, \&ok, *STDOUT{FORMAT}) {
     $::{BONK} = \"powie";
     *{"BONK"} = \&{"BONK"};
     eval 'is(BONK(), "powie",
-             "Assigment works when glob created midway (bug 45607)"); 1'
+             "Assignment works when glob created midway (bug 45607)"); 1'
 	or die $@;
 }
 
@@ -582,7 +610,7 @@ foreach my $type (qw(integer number string)) {
     local $SIG{__WARN__} = sub { $warn = $_[0] };
     use warnings;
     my $str = "$glob";
-    is($warn, '', "RT #60954 anon glob stringification shouln't warn");
+    is($warn, '', "RT #60954 anon glob stringification shouldn't warn");
     is($str,  '', "RT #60954 anon glob stringification should be empty");
 }
 
@@ -629,6 +657,7 @@ is (scalar $::{fake}, "*main::sym",
 	"Localized FAKE glob's value was correctly restored");
 
 # [perl #1804] *$x assignment when $x is a copy of another glob
+# And [perl #77508] (same thing with list assignment)
 {
     no warnings 'once';
     my $x = *_random::glob_that_is_not_used_elsewhere;
@@ -637,6 +666,12 @@ is (scalar $::{fake}, "*main::sym",
       "$x", '*_random::glob_that_is_not_used_elsewhere',
       '[perl #1804] *$x assignment when $x is FAKE',
     );
+    $x = *_random::glob_that_is_not_used_elsewhere;
+    (my $dummy, *$x) = (undef,[]);
+    is(
+      "$x", '*_random::glob_that_is_not_used_elsewhere',
+      '[perl #77508] *$x list assignment when $x is FAKE',
+    ) or require Devel::Peek, Devel::Peek::Dump($x);
 }
 
 # [perl #76540]
@@ -683,21 +718,13 @@ EOF
     'PVLV: assigning undef to the glob warns';
   }
 
-  # Neither should number assignment...
-  *$_ = 1;
-  is $_, "*main::1", "PVLV: integer-to-glob assignment assigns a glob";
-  *$_ = 2.0;
-  is $_, "*main::2", "PVLV: float-to-glob assignment assigns a glob";
-
-  # Nor reference assignment.
-  *$_ = \*thit;
-  is $_, "*main::thit", "PVLV: globref-to-glob assignment assigns a glob";
+  # Neither should reference assignment.
   *$_ = [];
-  is $_, "*main::thit", "PVLV: arrayref assignment assigns to the AV slot";
+  is $_, "*main::hon", "PVLV: arrayref assignment assigns to the AV slot";
 
   # Concatenation should still work.
   ok eval { $_ .= 'thlew' }, 'PVLV concatenation does not die' or diag $@;
-  is $_, '*main::thitthlew', 'PVLV concatenation works';
+  is $_, '*main::honthlew', 'PVLV concatenation works';
 
   # And we should be able to overwrite it with a string, number, or refer-
   # ence, too, if we omit the *.
@@ -783,6 +810,70 @@ EOF
  }}->($h{k});
 }
 
+*aieee = 4;
+pass('Can assign integers to typeglobs');
+*aieee = 3.14;
+pass('Can assign floats to typeglobs');
+*aieee = 'pi';
+pass('Can assign strings to typeglobs');
+
+{
+  package thrext;
+  sub TIESCALAR{bless[]}
+  sub STORE{ die "No!"}
+  sub FETCH{ no warnings 'once'; *thrit }
+  tie my $a, "thrext";
+  () = "$a"; # do a fetch; now $a holds a glob
+  eval { *$a = sub{} };
+  eval { $a = undef }; # workaround for untie($handle) bug
+  untie $a;
+  eval { $a = "bar" };
+  ::is $a, "bar",
+    "[perl #77812] Globs in tied scalars can be reified if STORE dies"
+}
+
+# These two crashed prior to 5.13.6. In 5.13.6 they were fatal errors. They
+# were fixed in 5.13.7.
+ok eval {
+  my $glob = \*heen::ISA;
+  delete $::{"heen::"};
+  *$glob = *bar; 
+}, "glob-to-*ISA assignment works when *ISA has lost its stash";
+ok eval {
+  my $glob = \*slare::ISA;
+  delete $::{"slare::"};
+  *$glob = []; 
+}, "array-to-*ISA assignment works when *ISA has lost its stash";
+# These two crashed in 5.13.6. They were likewise fixed in 5.13.7.
+ok eval {
+  sub greck;
+  my $glob = do { no warnings "once"; \*phing::foo};
+  delete $::{"phing::"};
+  *$glob = *greck; 
+}, "Assigning a glob-with-sub to a glob that has lost its stash warks";
+ok eval {
+  sub pon::foo;
+  my $glob = \*pon::foo;
+  delete $::{"pon::"};
+  *$glob = *foo; 
+}, "Assigning a glob to a glob-with-sub that has lost its stash warks";
+
+{
+  package Tie::Alias;
+  sub TIESCALAR{ bless \\pop }
+  sub FETCH { $${$_[0]} }
+  sub STORE { $${$_[0]} = $_[1] }
+  package main;
+  tie my $alias, 'Tie::Alias', my $var;
+  no warnings 'once';
+  $var = *galobbe;
+  {
+    local *$alias = [];
+    $var = 3;
+    is $alias, 3, "[perl #77926] Glob reification during localisation";
+  }
+}
+
 __END__
 Perl
 Rules