use warnings;
require './test.pl';
-plan( tests => 132 );
+plan( tests => 161 );
# type coersion on assignment
$foo = 'foo';
is($msg, '');
*foo = undef;
like($msg, qr/Undefined value assigned to typeglob/);
+
+ no warnings 'once';
+ # test warnings for converting globs to other forms
+ my $copy = *PWOMPF;
+ foreach ($copy, *SKREEE) {
+ $msg = '';
+ my $victim = sprintf "%d", $_;
+ like($msg, qr/Argument "\*main::[A-Z]{6}" isn't numeric in sprintf/,
+ "Warning on conversion to IV");
+ is($victim, 0);
+
+ $msg = '';
+ $victim = sprintf "%u", $_;
+ like($msg, qr/Argument "\*main::[A-Z]{6}" isn't numeric in sprintf/,
+ "Warning on conversion to UV");
+ is($victim, 0);
+
+ $msg = '';
+ $victim = sprintf "%e", $_;
+ like($msg, qr/Argument "\*main::[A-Z]{6}" isn't numeric in sprintf/,
+ "Warning on conversion to NV");
+ like($victim, qr/^0\.0+E\+?00/i, "Expect floating point zero");
+
+ $msg = '';
+ $victim = sprintf "%s", $_;
+ is($msg, '', "No warning on stringification");
+ is($victim, '' . $_);
+ }
}
my $test = curr_test();
my $w = '';
local $SIG{__WARN__} = sub { $w = $_[0] };
$result = *{$gr} = \&{"oonk"};
- like($w, qr/^Constant subroutine main::plunk redefined/,
- "Redefining a constant sub should warn");
+ 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 (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");
+{
+ use vars qw($glook $smek $foof);
+ # Check reference assignment isn't affected by the SV type (bug #38439)
+ $glook = 3;
+ $smek = 4;
+ $foof = "halt and cool down";
+
+ my $rv = \*smek;
+ is($glook, 3);
+ *glook = $rv;
+ is($glook, 4);
+
+ my $pv = "";
+ $pv = \*smek;
+ is($foof, "halt and cool down");
+ *foof = $pv;
+ is($foof, 4);
+}
+
format =
.
like ($@, qr/^Cannot convert a reference to $type to typeglob/,
"Cannot upgrade ref-to-$type to typeglob");
}
+
+{
+ no warnings qw(once uninitialized);
+ my $g = \*clatter;
+ my $r = eval {no strict; ${*{$g}{SCALAR}}};
+ is ($@, '', "PERL_DONT_CREATE_GVSV shouldn't affect thingy syntax");
+
+ $g = \*vowm;
+ $r = eval {use strict; ${*{$g}{SCALAR}}};
+ is ($@, '',
+ "PERL_DONT_CREATE_GVSV shouldn't affect thingy syntax under strict");
+}
+
+{
+ # Bug reported by broquaint on IRC
+ *slosh::{HASH}->{ISA}=[];
+ slosh->import;
+ pass("gv_fetchmeth coped with the unexpected");
+
+ # An audit found these:
+ {
+ package slosh;
+ sub rip {
+ my $s = shift;
+ $s->SUPER::rip;
+ }
+ }
+ eval {slosh->rip;};
+ like ($@, qr/^Can't locate object method "rip"/, "Even with SUPER");
+
+ is(slosh->isa('swoosh'), '');
+
+ $CORE::GLOBAL::{"lock"}=[];
+ eval "no warnings; lock";
+ like($@, qr/^Not enough arguments for lock/,
+ "Can't trip up general keyword overloading");
+
+ $CORE::GLOBAL::{"readline"}=[];
+ 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 $@;
+}
__END__
Perl
Rules