diff options
author | David Mitchell <davem@iabyn.com> | 2012-02-14 19:42:39 +0000 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2012-06-13 13:32:48 +0100 |
commit | d4a6f307a837e59c86cb6f6d9bb31984d15500b8 (patch) | |
tree | 908702b804974f6fdff95da03aa5f0cef7fb0e9f /lib | |
parent | 23af30a1edf3b57b8b6950f73f724cce1266fdbd (diff) | |
download | perl-d4a6f307a837e59c86cb6f6d9bb31984d15500b8.tar.gz |
undo temporarily reverted lib/overload.t tests"
some tests in lib/overload.t were temporarily removed earlier to ease
rebasing; add them back in now.
Diffstat (limited to 'lib')
-rw-r--r-- | lib/overload.t | 49 |
1 files changed, 48 insertions, 1 deletions
diff --git a/lib/overload.t b/lib/overload.t index d5c1833ef2..329b6c7e55 100644 --- a/lib/overload.t +++ b/lib/overload.t @@ -48,7 +48,7 @@ package main; $| = 1; BEGIN { require './test.pl' } -plan tests => 5055; +plan tests => 5059; use Scalar::Util qw(tainted); @@ -957,6 +957,18 @@ unless ($aaa) { } { + # check the invalid argument warning [perl #74098] + my $a = "" ; + local $SIG{__WARN__} = sub {$a = $_[0]} ; + $x = eval ' use overload "~|_|~" => sub{} ' ; + is($a, ""); + use warnings 'overload' ; + $x = eval ' use overload "~|_|~" => sub{} ' ; + like($a, qr/^overload arg '~\|_\|~' is invalid at \(eval \d+\) line /, + 'invalid arg warning'); +} + +{ my $c = 0; package ov_int1; use overload '""' => sub { 3+shift->[0] }, @@ -2245,4 +2257,39 @@ fresh_perl_is ::ok(1, 'no crash when undefining %overload::'); } +# [perl #40333] +# overload::Overloaded should not use a ->can designed for autoloading. +# This example attempts to be as realistic as possible. The o class has a +# default singleton object, but can have instances, too. The proxy class +# represents proxies for o objects, but class methods delegate to the +# singleton. +# overload::Overloaded used to return incorrect results for proxy objects. +package proxy { + sub new { bless [$_[1]], $_[0] } + sub AUTOLOAD { + our $AUTOLOAD =~ s/.*:://; + &_self->$AUTOLOAD; + } + sub can { SUPER::can{@_} || &_self->can($_[1]) } + sub _self { ref $_[0] ? $_[0][0] : $o::singleton } +} +package o { use overload '""' => sub { 'keck' }; + sub new { bless[], $_[0] } + our $singleton = o->new; } +ok !overload::Overloaded(new proxy new o), + 'overload::Overloaded does not incorrectly return true for proxy classes'; + +# Another test, based on the type of explosive test class for which +# perl #40333 was filed. +{ + package broken_can; + sub can {} + use overload '""' => sub {"Ahoy!"}; + + package main; + my $obj = bless [], 'broken_can'; + ok(overload::Overloaded($obj)); +} + + # EOF |