Make ~~ overloading only be invoked on the right argument

diff --git a/pp_ctl.c b/pp_ctl.c
index 5e8d557..c601f7c 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4006,7 +4006,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 #   define SM_SEEN_OTHER(sv) hv_exists_ent(seen_other, \
        sv_2mortal(newSViv(PTR2IV(sv))), 0)
 
-    if (SvAMAGIC(d) || SvAMAGIC(e)) {
+    if (SvAMAGIC(e)) {
        SV * const tmpsv = amagic_call(d, e, smart_amg, 0);
        if (tmpsv) {
            SPAGAIN;
@@ -4039,8 +4039,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
            RETPUSHYES;
     }
 
-    if ((sv_isobject(d) && (SvTYPE(SvRV(d)) != SVt_REGEXP))
-           || (sv_isobject(e) && (SvTYPE(SvRV(e)) != SVt_REGEXP)))
+    if (sv_isobject(e) && (SvTYPE(SvRV(e)) != SVt_REGEXP))
        Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation");
 
     /* ~~ sub */

diff --git a/t/op/smartmatch.t b/t/op/smartmatch.t
index 3838518..75c0ec0 100644 (file)
--- a/t/op/smartmatch.t
+++ b/t/op/smartmatch.t
@@ -150,7 +150,7 @@ __DATA__
 
 # regular object
 @      $obj            $obj
-@      $ov_obj         $obj    TODO
+@      $ov_obj         $obj
 @      \&fatal         $obj
 @      \&FALSE         $obj
 @      \&foo           $obj

diff --git a/t/op/switch.t b/t/op/switch.t
index f4cedba..9ca4f13 100644 (file)
--- a/t/op/switch.t
+++ b/t/op/switch.t
@@ -8,7 +8,7 @@ BEGIN {
 use strict;
 use warnings;
 
-use Test::More tests => 124;
+use Test::More tests => 118;
 
 # The behaviour of the feature pragma should be tested by lib/switch.t
 # using the tests in t/lib/switch/*. This file tests the behaviour of
@@ -772,6 +772,7 @@ SKIP: {
     { package OverloadTest;
 
       use overload '""' => sub{"string value of obj"};
+      use overload 'eq' => sub{"$_[0]" eq "$_[1]"};
 
       use overload "~~" => sub {
          my ($self, $other, $reversed) = @_;
@@ -806,11 +807,8 @@ SKIP: {
            default {$matched = 0}
        }
     
-       is($obj->{called},  1, "$test: called");
-       ok($matched, "$test: matched");
-       is($obj->{left}, "string value of obj", "$test: left");
-       is($obj->{right}, "other arg", "$test: right");
-       ok(!$obj->{reversed}, "$test: not reversed");
+       is($obj->{called}, 0, "$test: called");
+       ok(!$matched, "$test: not matched");
     }
 
     {
@@ -821,11 +819,8 @@ SKIP: {
            when ("other arg") {$matched = 1}
        }
     
-       is($obj->{called},  1, "$test: called");
+       is($obj->{called}, 0, "$test: called");
        ok(!$matched, "$test: not matched");
-       is($obj->{left}, "string value of obj", "$test: left");
-       is($obj->{right}, "other arg", "$test: right");
-       ok(!$obj->{reversed}, "$test: not reversed");
     }
 
     {