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

diff --git a/gv.c b/gv.c
index 3e428a7..e03521e 100644 (file)
--- 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 ade87f2..b004cff 100644 (file)
--- 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');
+
+}