| Subject: | is_deeply calls stringification on non-blessed references |
As is_deeply() checks the structures it uses the overloading on the blessed references it has. However, it doesn't first check to make sure that it is a blessed reference. This causes it to call stringification on packages that have the same name as the contents of a string.
Example:
=======CODE======
package TestPackage;
use overload q{""} => sub { warn "Why are you calling me?" };
package main;
use Test::More qw(no_plan);
is_deeply(['TestPackage'], ['TestPackage']);
=======OUTPUT=====
Why are you calling me? at ./ref-test.pl line 5.
Why are you calling me? at ./ref-test.pl line 5.
ok 1
1..1
===================
This warns twice because the stringification sub of TestPackage is being called.
I've attached a patch to change the check in the _unoverload() method to check if the reference is blessed instead of just defined.
Andrew Parker
diff -uNr Test-Simple-0.60/lib/Test/Builder.pm Test-Simple-0.60.overload-fix/lib/Test/Builder.pm
--- Test-Simple-0.60/lib/Test/Builder.pm 2005-05-03 14:24:06.000000000 -0700
+++ Test-Simple-0.60.overload-fix/lib/Test/Builder.pm 2005-09-20 11:55:57.743756174 -0700
@@ -8,6 +8,8 @@
use strict;
use vars qw($VERSION);
+use Scalar::Util qw(blessed);
+
$VERSION = '0.30';
$VERSION = eval $VERSION; # make the alpha version come out as a number
@@ -464,7 +466,7 @@
foreach my $thing (@_) {
eval {
- if( defined $$thing ) {
+ if(blessed($$thing)) {
if( my $string_meth = overload::Method($$thing, '""') ) {
$$thing = $$thing->$string_meth();
}
diff -uNr Test-Simple-0.60/t/overload.t Test-Simple-0.60.overload-fix/t/overload.t
--- Test-Simple-0.60/t/overload.t 2005-02-25 22:15:31.000000000 -0800
+++ Test-Simple-0.60.overload-fix/t/overload.t 2005-09-20 11:54:30.673897223 -0700
@@ -18,7 +18,7 @@
plan skip_all => "needs overload.pm";
}
else {
- plan tests => 7;
+ plan tests => 9;
}
}
@@ -35,6 +35,12 @@
bless { string => shift, num => shift }, $class;
}
+package NoOverloadCall;
+
+our $overload_called = 0;
+use overload
+ q{""} => sub { $overload_called = 1; };
+
package main;
@@ -48,3 +54,8 @@
is_deeply [$obj], ['foo'], 'is_deeply with string overloading';
ok eq_array([$obj], ['foo']), 'eq_array ...';
ok eq_hash({foo => $obj}, {foo => 'foo'}), 'eq_hash ...';
+
+is_deeply ['NoOverloadCall'], ['NoOverloadCall'],
+ 'Strings do not get interpreted as package names';
+ok !$NoOverloadCall::overload_called,
+ 'Strings do not get interpreted as package names';