diff options
| -rw-r--r-- | pod/perlsyn.pod | 1 | ||||
| -rw-r--r-- | pp_ctl.c | 21 | ||||
| -rw-r--r-- | t/op/smartmatch.t | 20 |
3 files changed, 35 insertions, 7 deletions
diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod index 4302cf495f..20ec68e02b 100644 --- a/pod/perlsyn.pod +++ b/pod/perlsyn.pod @@ -717,6 +717,7 @@ and "Array" entries apply in those cases. (For blessed references, the Array Regex array grep grep /$b/, @$a Any Regex pattern match $a =~ /$b/ + Object Any invokes ~~ overloading on $object, or falls back: Any Num numeric equality $a == $b Num numish[4] numeric equality $a == $b Any Any string equality $a eq $b @@ -4001,6 +4001,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) SV *e = TOPs; /* e is for 'expression' */ SV *d = TOPm1s; /* d is for 'default', as in PL_defgv */ + /* First of all, handle overload magic of the rightmost argument */ if (SvAMAGIC(e)) { SV * const tmpsv = amagic_call(d, e, smart_amg, 0); if (tmpsv) { @@ -4371,9 +4372,25 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) RETURN; } } - /* ~~ X..Y TODO */ /* ~~ scalar */ - else if (SvNIOK(e) || (SvPOK(e) && looks_like_number(e) && SvNIOK(d))) { + /* See if there is overload magic on left */ + else if (object_on_left && SvAMAGIC(d)) { + SV *tmpsv; + PUSHs(d); PUSHs(e); + PUTBACK; + tmpsv = amagic_call(d, e, smart_amg, AMGf_noright); + if (tmpsv) { + SPAGAIN; + (void)POPs; + SETs(tmpsv); + RETURN; + } + SP -= 2; + goto sm_any_scalar; + } + else + sm_any_scalar: + if (SvNIOK(e) || (SvPOK(e) && looks_like_number(e) && SvNIOK(d))) { /* numeric comparison */ PUSHs(d); PUSHs(e); PUTBACK; diff --git a/t/op/smartmatch.t b/t/op/smartmatch.t index 5dfebbd842..8c487688a1 100644 --- a/t/op/smartmatch.t +++ b/t/op/smartmatch.t @@ -37,7 +37,15 @@ tie my %tied_hash, 'Tie::StdHash'; { package Test::Object::WithOverload; sub new { bless { key => 'magic' } } - use overload '~~' => sub { my %hash = %{ $_[0] }; $_[1] eq $hash{key} }; + use overload '~~' => sub { + my %hash = %{ $_[0] }; + if ($_[2]) { # arguments reversed ? + return $_[1] eq reverse $hash{key}; + } + else { + return $_[1] eq $hash{key}; + } + }; use overload '""' => sub { "stringified" }; use overload 'eq' => sub {"$_[0]" eq "$_[1]"}; } @@ -158,15 +166,15 @@ __DATA__ # Any ~~ object overloaded ! \&fatal $ov_obj - 'magic' $ov_obj -! 'not magic' $ov_obj + 'cigam' $ov_obj +! 'cigam on' $ov_obj ! $obj $ov_obj ! undef $ov_obj # regular object @ $obj $obj @ $ov_obj $obj -@ \&fatal $obj +=@ \&fatal $obj @ \&FALSE $obj @ \&foo $obj @ sub { 1 } $obj @@ -183,7 +191,9 @@ __DATA__ # object (overloaded or not) ~~ Any $obj qr/NoOverload/ $ov_obj qr/^stringified$/ - $ov_obj "stringified" + "$ov_obj" "stringified" + $ov_obj 'magic' +! $ov_obj 'not magic' # ~~ Coderef sub{0} sub { ref $_[0] eq "CODE" } |