use warnings;
-plan( tests => 220 );
+plan( tests => 231 );
# type coersion on assignment
$foo = 'foo';
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;
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};
$::{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 $@;
}
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");
}
"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;
"$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]
'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 *.
}}->($h{k});
}
-# [perl #77928] Glob slot assignment and set-magic
+*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 Readonly::Alias;
- sub TIESCALAR { bless \(my $x = \pop) }
- sub FETCH { $${$_[0]} }
- sub STORE { die "Assignment to read-only value" }
- package main;
- tie my $alias, "Readonly::Alias", my $var;
- $var = *bength;
- # Now modify a glob slot, not the alias itself:
- ok(scalar eval { *$alias = [] }, 'glob slot assignment skips set-magic');
+ 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__