Warning bit fixes to t/op/caller.t

[p5sagit/p5-mst-13.2.git] / t / op / gv.t

diff --git a/t/op/gv.t b/t/op/gv.t
index 3164c35..bca84e7 100755 (executable)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
 use warnings;
 
 require './test.pl';
-plan( tests => 138 );
+plan( tests => 160 );
 
 # type coersion on assignment
 $foo = 'foo';
@@ -89,6 +89,34 @@ is (scalar %foo, 0);
     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();
@@ -425,6 +453,38 @@ foreach my $value ([1,2,3], {1=>2}, *STDOUT{IO}, \&ok, *STDOUT{FORMAT}) {
        "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");
+}
 __END__
 Perl
 Rules