summaryrefslogtreecommitdiff
path: root/lib/overload.t
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2012-02-14 19:42:39 +0000
committerDavid Mitchell <davem@iabyn.com>2012-06-13 13:32:48 +0100
commitd4a6f307a837e59c86cb6f6d9bb31984d15500b8 (patch)
tree908702b804974f6fdff95da03aa5f0cef7fb0e9f /lib/overload.t
parent23af30a1edf3b57b8b6950f73f724cce1266fdbd (diff)
downloadperl-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/overload.t')
-rw-r--r--lib/overload.t49
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