In perl.git, the branch smartmatch has been updated <http://perl5.git.perl.org/perl.git/commitdiff/41e726ac827d803b499877b6a79913968b88cf46?hp=d0b243e39ca09d7da156b4027255b58fa0a84810>
- Log ----------------------------------------------------------------- commit 41e726ac827d803b499877b6a79913968b88cf46 Author: Rafael Garcia-Suarez <[email protected]> Date: Sat May 9 15:25:41 2009 +0200 Treat blessed references on the left of C<~~> as scalars M pp_ctl.c M t/op/smartmatch.t commit 015eb7b967ac690ef0b530c0aa564f080ff0fa4b Author: Rafael Garcia-Suarez <[email protected]> Date: Sat May 9 15:09:39 2009 +0200 Implement distributivity in $scalar ~~ @array Note that undef ~~ @array is not distributive, it only tests for definedness of array elements. M pp_ctl.c M t/op/smartmatch.t ----------------------------------------------------------------------- Summary of changes: pp_ctl.c | 75 +++++++++++++++++++++++++++++----------------------- t/op/smartmatch.t | 21 ++++++++++++--- 2 files changed, 59 insertions(+), 37 deletions(-) diff --git a/pp_ctl.c b/pp_ctl.c index 6a5ea65..c6bb46a 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -3997,6 +3997,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) dVAR; dSP; + bool object_on_left = FALSE; SV *e = TOPs; /* e is for 'expression' */ SV *d = TOPm1s; /* d is for 'default', as in PL_defgv */ @@ -4035,11 +4036,16 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) if (sv_isobject(e) && (SvTYPE(SvRV(e)) != SVt_REGEXP)) Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation"); + if (sv_isobject(d) && (SvTYPE(SvRV(d)) != SVt_REGEXP)) + object_on_left = TRUE; /* ~~ sub */ if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_PVCV) { I32 c; - if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) { + if (object_on_left) { + goto sm_any_sub; /* Treat objects like scalars */ + } + else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) { /* Test sub truth for each key */ HE *he; bool andedresults = TRUE; @@ -4098,6 +4104,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) RETPUSHNO; } else { + sm_any_sub: ENTER; SAVETMPS; PUSHMARK(SP); @@ -4116,7 +4123,10 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) } /* ~~ %hash */ else if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_PVHV) { - if (!SvOK(d)) { + if (object_on_left) { + goto sm_any_hash; /* Treat objects like scalars */ + } + else if (!SvOK(d)) { RETPUSHNO; } else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) { @@ -4209,6 +4219,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) RETPUSHNO; } else { + sm_any_hash: if (hv_exists_ent(MUTABLE_HV(SvRV(e)), d, 0)) RETPUSHYES; else @@ -4217,7 +4228,10 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) } /* ~~ @array */ else if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_PVAV) { - if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) { + if (object_on_left) { + goto sm_any_array; /* Treat objects like scalars */ + } + else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) { AV * const other_av = MUTABLE_AV(SvRV(e)); const I32 other_len = av_len(other_av) + 1; I32 i; @@ -4303,45 +4317,40 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) destroy_matcher(matcher); RETPUSHNO; } - else if (SvNIOK(d)) { + else if (!SvOK(d)) { + /* undef ~~ array */ + const I32 this_len = av_len(MUTABLE_AV(SvRV(e))); I32 i; - for(i = 0; i <= AvFILL(MUTABLE_AV(SvRV(e))); ++i) { + for (i = 0; i <= this_len; ++i) { SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE); - if (!svp) - continue; - - PUSHs(d); - PUSHs(*svp); - PUTBACK; - if (CopHINTS_get(PL_curcop) & HINT_INTEGER) - (void) pp_i_eq(); - else - (void) pp_eq(); - SPAGAIN; - if (SvTRUEx(POPs)) + if (!svp || !SvOK(*svp)) RETPUSHYES; } RETPUSHNO; } - else if (SvPOK(d)) { - const I32 this_len = av_len(MUTABLE_AV(SvRV(e))); - I32 i; + else { + sm_any_array: + { + I32 i; + const I32 this_len = av_len(MUTABLE_AV(SvRV(e))); - for(i = 0; i <= this_len; ++i) { - SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE); - if (!svp) - continue; - - PUSHs(d); - PUSHs(*svp); - PUTBACK; - (void) pp_seq(); - SPAGAIN; - if (SvTRUEx(POPs)) - RETPUSHYES; + for (i = 0; i <= this_len; ++i) { + SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE); + if (!svp) + continue; + + PUSHs(d); + PUSHs(*svp); + PUTBACK; + /* infinite recursion isn't supposed to happen here */ + (void) do_smartmatch(NULL, NULL); + SPAGAIN; + if (SvTRUEx(POPs)) + RETPUSHYES; + } + RETPUSHNO; } - RETPUSHNO; } } /* ~~ qr// */ diff --git a/t/op/smartmatch.t b/t/op/smartmatch.t index 8047451..0b5c9a1 100644 --- a/t/op/smartmatch.t +++ b/t/op/smartmatch.t @@ -13,6 +13,7 @@ use Tie::Hash; # Predeclare vars used in the tests: my @empty; my %empty; +my @sparse; $sparse[2] = 2; my $deep1 = []; push @$deep1, \$deep1; my $deep2 = []; push @$deep2, \$deep2; @@ -200,8 +201,8 @@ __DATA__ qr// \&bar ! [1] \&foo ! {a=>1} \&foo - $obj sub { ref $_[0] =~ /NoOverload/ } TODO - $ov_obj sub { ref $_[0] =~ /CopyOverload/ } TODO + $obj sub { ref($_[0]) =~ /NoOverload/ } + $ov_obj sub { ref($_[0]) =~ /CopyOverload/ } # empty stuff matches, because the sub is never called: [] \&foo {} \&foo @@ -316,7 +317,7 @@ __DATA__ # - an object ! $obj @fooormore - $obj [sub{ref shift}] TODO + $obj [sub{ref shift}] # - works with lists instead of arrays "foo" qw(foo bar) TODO @@ -331,7 +332,7 @@ __DATA__ ! /bar/ @fooormore # - a number - 2 [qw(1foo 2bar)] + 2 [qw(1.00 2.00)] 2 [qw(foo 2)] 2.0_0e+0 [qw(foo 2)] ! 2 [qw(1foo bar2)] @@ -340,6 +341,18 @@ __DATA__ ! "2" [qw(1foo 2bar)] "2bar" [qw(1foo 2bar)] +# - undef + undef [1, 2, undef, 4] +! undef [1, 2, [undef], 4] +! undef @fooormore + undef @sparse + +# - nested arrays and ~~ distributivity + 11 [[11]] +! 11 [[12]] + "foo" [{foo => "bar"}] +! "bar" [{foo => "bar"}] + # Number against number 2 2 20 2_0 -- Perl5 Master Repository
