Re: [perl #41546] perl 5.8.x bug: overloaded 'eq' does not work with 'nomethod'

Message-ID: <20070221215316.GF5646@bort.ca>

p4raw-id: //depot/perl@30383

2 files changed, 61 insertions, 1 deletions

diff --git a/gv.c b/gv.c
index 3e428a7700..e03521e947 100644
--- a/gv.c
+++ b/gv.c
@@ -1871,6 +1871,19 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
     } else {
     not_found:			/* No method found, either report or croak */
       switch (method) {
+	 case lt_amg:
+	 case le_amg:
+	 case gt_amg:
+	 case ge_amg:
+	 case eq_amg:
+	 case ne_amg:
+	 case slt_amg:
+	 case sle_amg:
+	 case sgt_amg:
+	 case sge_amg:
+	 case seq_amg:
+	 case sne_amg:
+	   postpr = 0; break;
 	 case to_sv_amg:
 	 case to_av_amg:
 	 case to_hv_amg:
diff --git a/lib/overload.t b/lib/overload.t
index ade87f2926..b004cff0fa 100644
--- a/lib/overload.t
+++ b/lib/overload.t
@@ -47,7 +47,7 @@ sub numify { 0 + "${$_[0]}" }	# Not needed, additional overhead
 package main;
 
 $| = 1;
-use Test::More tests => 512;
+use Test::More tests => 522;
 
 
 $a = new Oscalar "087";
@@ -1286,3 +1286,50 @@ foreach my $op (qw(<=> == != < <= > >=)) {
     $c |= $d;
     is($c->val, 'c | d', "overloaded |= (by fallback) works");
 }
+
+{
+    # comparison operators with nomethod
+    my $warning = "";
+    my $method;
+
+    package nomethod_false;
+    use overload nomethod => sub { $method = 'nomethod'; 0 };
+
+    package nomethod_true;
+    use overload nomethod => sub { $method= 'nomethod'; 'true' };
+
+    package main;
+    local $^W = 1;
+    local $SIG{__WARN__} = sub { $warning = $_[0] };
+
+    my $f = bless [], 'nomethod_false';
+    ($warning, $method) = ("", "");
+    is($f eq 'whatever', 0, 'nomethod makes eq return 0');
+    is($method, 'nomethod');
+
+    my $t = bless [], 'nomethod_true';
+    ($warning, $method) = ("", "");
+    is($t eq 'whatever', 'true', 'nomethod makes eq return "true"');
+    is($method, 'nomethod');
+    is($warning, "", 'nomethod eq need not return number');
+
+    eval q{ 
+        package nomethod_false;
+        use overload cmp => sub { $method = 'cmp'; 0 };
+    };
+    $f = bless [], 'nomethod_false';
+    ($warning, $method) = ("", "");
+    ok($f eq 'whatever', 'eq falls back to cmp (nomethod not called)');
+    is($method, 'cmp');
+
+    eval q{
+        package nomethod_true;
+        use overload cmp => sub { $method = 'cmp'; 'true' };
+    };
+    $t = bless [], 'nomethod_true';
+    ($warning, $method) = ("", "");
+    ok($t eq 'whatever', 'eq falls back to cmp (nomethod not called)');
+    is($method, 'cmp');
+    like($warning, qr/isn't numeric/, 'cmp should return number');
+
+}