In perl.git, the branch smartmatch has been updated <http://perl5.git.perl.org/perl.git/commitdiff/6d743019f3ff1c2efcf74a1e4f98ea5bd3b7351a?hp=031a44ed339cfee9d4b2bc19abf15fa19412c9fd>
- Log ----------------------------------------------------------------- commit 6d743019f3ff1c2efcf74a1e4f98ea5bd3b7351a Author: Rafael Garcia-Suarez <[email protected]> Date: Fri May 8 22:37:03 2009 +0200 Make ~~ overloading only be invoked on the right argument ----------------------------------------------------------------------- Summary of changes: pp_ctl.c | 5 ++--- t/op/smartmatch.t | 2 +- t/op/switch.t | 15 +++++---------- 3 files changed, 8 insertions(+), 14 deletions(-) diff --git a/pp_ctl.c b/pp_ctl.c index 5e8d557..c601f7c 100644 --- 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 --- 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 --- 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"); } { -- Perl5 Master Repository
