use warnings;
require './test.pl';
-plan( tests => 160 );
+plan( tests => 182 );
# type coersion on assignment
$foo = 'foo';
ok(!defined @{$a});
ok(!defined *{$a});
- ok(!defined %{$a});
+ {
+ no warnings 'deprecated';
+ ok(!defined %{$a});
+ }
ok(!defined *{$a});
ok(!defined ${$a});
is (eval 'spritsits', "Value", "Constant has correct value");
is (ref \$::{spritsits}, 'GLOB', "Symbol table has full typeglob");
-my $result;
# Check that assignment to an existing typeglob works
{
my $w = '';
local $SIG{__WARN__} = sub { $w = $_[0] };
- $result = *{"plunk"} = \&{"oonk"};
+ *{"plunk"} = [];
+ *{"plunk"} = \&{"oonk"};
is($w, '', "Should be no warning");
}
-is (ref \$result, 'GLOB',
- "Non void assignment should still return a typeglob");
-
is (ref $::{oonk}, 'SCALAR', "Export doesn't affect original");
is (eval 'plunk', "Value", "Constant has correct value");
is (ref \$::{plunk}, 'GLOB', "Symbol table has full typeglob");
{
my $w = '';
local $SIG{__WARN__} = sub { $w = $_[0] };
- $result = *{$gr} = \&{"oonk"};
+ *{$gr} = \&{"oonk"};
is($w, '', "Redefining a constant sub to another constant sub with the same underlying value should not warn (It's just re-exporting, and that was always legal)");
}
is (eval 'plunk', "Value", "Constant has correct value");
is (ref \$::{plunk}, 'GLOB', "Symbol table has full typeglob");
+# Non-void context should defeat the optimisation, and will cause the original
+# to be promoted (what change 26482 intended)
+my $result;
+{
+ my $w = '';
+ local $SIG{__WARN__} = sub { $w = $_[0] };
+ $result = *{"awkkkkkk"} = \&{"oonk"};
+ is($w, '', "Should be no warning");
+}
+
+is (ref \$result, 'GLOB',
+ "Non void assignment should still return a typeglob");
+
+is (ref \$::{oonk}, 'GLOB', "This export does affect original");
+is (eval 'plunk', "Value", "Constant has correct value");
+is (ref \$::{plunk}, 'GLOB', "Symbol table has full typeglob");
+
+delete $::{oonk};
+$::{oonk} = \"Value";
+
+sub non_dangling {
+ my $w = '';
+ local $SIG{__WARN__} = sub { $w = $_[0] };
+ *{"zap"} = \&{"oonk"};
+ is($w, '', "Should be no warning");
+}
+
+non_dangling();
+is (ref $::{oonk}, 'SCALAR', "Export doesn't affect original");
+is (eval 'zap', "Value", "Constant has correct value");
+is (ref $::{zap}, 'SCALAR', "Exported target is also a PCS");
+
+sub dangling {
+ local $SIG{__WARN__} = sub { die $_[0] };
+ *{"biff"} = \&{"oonk"};
+}
+
+dangling();
+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");
+
{
use vars qw($glook $smek $foof);
# Check reference assignment isn't affected by the SV type (bug #38439)
"Can't trip up general keyword overloading");
$CORE::GLOBAL::{"readline"}=[];
- eval "no warnings; <STDOUT>";
+ eval "<STDOUT> if 0";
is($@, '', "Can't trip up readline overloading");
$CORE::GLOBAL::{"readpipe"}=[];
eval "`` if 0";
is($@, '', "Can't trip up readpipe overloading");
}
+
+{
+ die if exists $::{BONK};
+ $::{BONK} = \"powie";
+ *{"BONK"} = \&{"BONK"};
+ eval 'is(BONK(), "powie",
+ "Assigment works when glob created midway (bug 45607)"); 1'
+ or die $@;
+}
+
+# For now these tests are here, but they would probably be better in a file for
+# tests for croaks. (And in turn, that probably deserves to be in a different
+# directory. Gerard Goossen has a point about the layout being unclear
+
+sub coerce_integer {
+ no warnings 'numeric';
+ $_[0] |= 0;
+}
+sub coerce_number {
+ no warnings 'numeric';
+ $_[0] += 0;
+}
+sub coerce_string {
+ $_[0] .= '';
+}
+
+foreach my $type (qw(integer number string)) {
+ my $prog = "coerce_$type(*STDERR)";
+ is (scalar eval "$prog; 1", undef, "$prog failed...");
+ like ($@, qr/Can't coerce GLOB to $type in/,
+ "with the correct error message");
+}
+
+# RT #60954 anonymous glob should be defined, and not coredump when
+# stringified. The behaviours are:
+#
+# defined($glob) "$glob"
+# 5.8.8 false "" with uninit warning
+# 5.10.0 true (coredump)
+# 5.12.0 true ""
+
+{
+ my $io_ref = *STDOUT{IO};
+ my $glob = *$io_ref;
+ ok(defined $glob, "RT #60954 anon glob should be defined");
+
+ my $warn = '';
+ local $SIG{__WARN__} = sub { $warn = $_[0] };
+ use warnings;
+ my $str = "$glob";
+ is($warn, '', "RT #60954 anon glob stringification shouln't warn");
+ is($str, '', "RT #60954 anon glob stringification should be empty");
+}
+
+# [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.)
+{
+ $m = 2; $m=~s/./0/gems; $m= *STDERR;
+ is(
+ "$m", "*main::STDERR",
+ '[perl #71254] assignment of globs to vars with pos'
+ );
+}
+
__END__
Perl
Rules