In perl.git, the branch smartmatch has been updated <http://perl5.git.perl.org/perl.git/commitdiff/7c41e62ef63f12c6c4bde601a6af608e863d3f10?hp=fc8390768718c75e7007d3afdce4bc61fb3ea97b>
- Log ----------------------------------------------------------------- commit 7c41e62ef63f12c6c4bde601a6af608e863d3f10 Author: Rafael Garcia-Suarez <[email protected]> Date: Tue Mar 24 18:30:20 2009 +0100 Inline macro tryAMAGICbinSET() in smart match routine (to build tricks on a sane base) M pp_ctl.c commit 2522c35a141b3975f20e7418066d600920f74ac7 Author: Rafael Garcia-Suarez <[email protected]> Date: Tue Mar 24 18:21:59 2009 +0100 More tests. Simplify tests for ~~ overloading M t/op/smartmatch.t ----------------------------------------------------------------------- Summary of changes: pp_ctl.c | 10 +++++++++- t/op/smartmatch.t | 26 ++++++++++++++++---------- 2 files changed, 25 insertions(+), 11 deletions(-) diff --git a/pp_ctl.c b/pp_ctl.c index a8a3610..1c68602 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -4033,7 +4033,15 @@ 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) - tryAMAGICbinSET(smart, 0); + if (SvAMAGIC(d) || SvAMAGIC(e)) { + SV * const tmpsv = amagic_call(d, e, smart_amg, 0); + if (tmpsv) { + SPAGAIN; + (void)POPs; + SETs(tmpsv); + RETURN; + } + } SP -= 2; /* Pop the values */ diff --git a/t/op/smartmatch.t b/t/op/smartmatch.t index 6993c2e..b2a213e 100644 --- a/t/op/smartmatch.t +++ b/t/op/smartmatch.t @@ -29,8 +29,8 @@ tie my %tied_hash, 'Tie::StdHash'; { package Test::Object::CopyOverload; - sub new { bless { key => 1 } } - use overload '~~' => sub { my %hash = %{ $_[0] }; $_[1] ~~ %hash }; + sub new { bless { key => 'magic' } } + use overload '~~' => sub { my %hash = %{ $_[0] }; $_[1] eq $hash{key} }; } our $ov_obj = Test::Object::CopyOverload->new; @@ -87,6 +87,7 @@ sub fatal {die "fatal sub\n"} # to test constant folding sub FALSE() { 0 } sub TRUE() { 1 } +sub NOT_DEF() { undef } # Prefix character : # - expected to match @@ -134,18 +135,17 @@ __DATA__ ! !1 undef undef undef (my $u) undef + NOT_DEF undef + &NOT_DEF undef # Any ~~ object overloaded # object overloaded ~~ Any - $ov_obj $ov_obj =! $ov_obj \&fatal -= $ov_obj {"key" => 2} -=! $ov_obj {"key" => 1, bar => 2} -= $ov_obj /key/ -=! $ov_obj /bar/ += $ov_obj 'magic' +=! $ov_obj 'not magic' +=! $ov_obj $obj # regular object -=@ $obj $ov_obj @ $obj $obj =@ $obj \&fatal =@ $obj \&FALSE @@ -217,7 +217,7 @@ __DATA__ \%main:: {map {$_ => 'x'} keys %main::} # - tied hash ref - \%hash \%tied_hash += \%hash \%tied_hash \%tied_hash \%tied_hash # - an array ref @@ -245,6 +245,7 @@ __DATA__ ! "baz" +{foo => 1, bar => 2} # - undef +! undef { hop => 'zouu' } ! undef %hash ! undef +{"" => "empty key"} ! undef {} @@ -252,11 +253,15 @@ __DATA__ # ARRAY ref against: # - another array ref [] [] -! [] [1] +=! [] [1] ! [["foo"], ["bar"]] [qr/o/, qr/a/] [["foo"], ["bar"]] [qr/ARRAY/, qr/ARRAY/] ["foo", "bar"] [qr/o/, qr/a/] + ["foo", "bar"] [["foo"], ["bar"]] ! ["foo", "bar"] [qr/o/, "foo"] + ["foo", undef, "bar"] [qr/o/, undef, "bar"] + ["foo", undef, "bar"] [qr/o/, "", "bar"] +! ["foo", "", "bar"] [qr/o/, undef, "bar"] $deep1 $deep1 ! $deep1 $deep2 @@ -299,6 +304,7 @@ __DATA__ # Regex against number 12345 qr/3/ +! 12345 qr/7/ # Test the implicit referencing 7 @nums -- Perl5 Master Repository
