In perl.git, the branch smartmatch has been updated <http://perl5.git.perl.org/perl.git/commitdiff/a566f585deae885dd3accdc93186eed7bf302b77?hp=61a621c635b84b53e4eb7d27f7e28c7cd3bdf7e6>
- Log ----------------------------------------------------------------- commit a566f585deae885dd3accdc93186eed7bf302b77 Author: Rafael Garcia-Suarez <[email protected]> Date: Mon Mar 23 17:17:03 2009 +0100 Make ~~ qr// non-commutative Pass elements in correct order to the sub-smart-match when comparing two arrays. And more tests M pp_ctl.c M t/op/smartmatch.t commit b0138e9991650fb38f2b288d28e609063075258b Author: Rafael Garcia-Suarez <[email protected]> Date: Mon Mar 23 16:57:57 2009 +0100 Refactoring work on '~~ @array' implementation (remove commutativity) M pp_ctl.c M t/op/smartmatch.t commit b38a9f03ccfb6bed7372d1c19957d641d2b57699 Author: Rafael Garcia-Suarez <[email protected]> Date: Mon Mar 23 16:55:52 2009 +0100 Revert order of ~~ in definition of smart matching against arrays This allows to remove a special case (Hash ~~ Array). We're also going to reuse ~~ in the Array ~~ Hash smart match definition. More tests will be needed. M pod/perlsyn.pod commit 2a37c5e7310aa2e0852ae3dcc39c0d69b41babe6 Author: Rafael Garcia-Suarez <[email protected]> Date: Mon Mar 23 15:45:55 2009 +0100 Add more tests with an empty hash on the right of ~~ M pod/perlsyn.pod M t/op/smartmatch.t ----------------------------------------------------------------------- Summary of changes: pod/perlsyn.pod | 5 +-- pp_ctl.c | 96 +++++++++++++++++++++++++++-------------------------- t/op/smartmatch.t | 40 +++++++++++++--------- 3 files changed, 75 insertions(+), 66 deletions(-) diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod index 52a3f87..5b1af05 100644 --- a/pod/perlsyn.pod +++ b/pod/perlsyn.pod @@ -688,15 +688,14 @@ entries apply in those cases. Any CodeRef scalar sub truth $b->($a) Hash Hash hash keys identical [sort keys %$a]~~[sort keys %$b] - Array Hash hash slice existence @$a == grep {exists $b->{$_}} @$a + Array Hash hash slice existence[1] @$a == grep $_ ~~ $b, @$a Regex Hash hash key grep[1] grep /$a/, keys %$b undef Hash always false (undef can't be a key) Any Hash hash entry existence exists $b->{$a} - Hash Array hash slice existence[1] @$b == grep {exists $a->{$_}} @$b Array Array arrays are comparable[2] Any Array match against an array element[3] - grep $a ~~ $_, @$b + grep $_ ~~ $a, @$b Hash Regex hash key grep grep /$b/, keys %$a Array Regex array grep grep /$b/, @$a diff --git a/pp_ctl.c b/pp_ctl.c index 3977953..74881c0 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -4027,28 +4027,6 @@ 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 */ SV *This, *Other; /* 'This' (and Other to match) to play with C++ */ - REGEXP *this_regex, *other_regex; - -# define SM_REF(type) ( \ - (SvROK(d) && (SvTYPE(This = SvRV(d)) == SVt_##type) && (Other = e)) \ - || (SvROK(e) && (SvTYPE(This = SvRV(e)) == SVt_##type) && (Other = d))) - -# define SM_REGEX ( \ - (SvROK(d) && (SvTYPE(This = SvRV(d)) == SVt_REGEXP) \ - && (this_regex = (REGEXP*) This) \ - && (Other = e)) \ - || \ - (SvROK(e) && (SvTYPE(This = SvRV(e)) == SVt_REGEXP) \ - && (this_regex = (REGEXP*) This) \ - && (Other = d)) ) - -# define SM_OTHER_REF(type) \ - (SvROK(Other) && SvTYPE(SvRV(Other)) == SVt_##type) - -# define SM_OTHER_REGEX (SvROK(Other) \ - && (SvTYPE(SvRV(Other)) == SVt_REGEXP) \ - && (other_regex = (REGEXP*) SvRV(Other))) - # define SM_SEEN_THIS(sv) hv_exists_ent(seen_this, \ sv_2mortal(newSViv(PTR2IV(sv))), 0) @@ -4073,6 +4051,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) if (SvGMAGICAL(e)) e = sv_mortalcopy(e); + /* ~~ undef */ if (!SvOK(e)) { if (SvOK(d)) RETPUSHNO; @@ -4084,6 +4063,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) || (sv_isobject(e) && (SvTYPE(SvRV(e)) != SVt_REGEXP))) Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation"); + /* ~~ sub */ if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_PVCV) { I32 c; if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) { @@ -4161,6 +4141,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) RETURN; } } + /* ~~ %hash */ else if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_PVHV) { if (!SvOK(d)) { RETPUSHNO; @@ -4238,10 +4219,8 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) } RETPUSHNO; } - else if (SvROK(d) - && (SvTYPE(SvRV(d)) == SVt_REGEXP) - && (other_regex = (REGEXP*) SvRV(d))) { - PMOP * const matcher = make_matcher(other_regex); + else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_REGEXP) { + PMOP * const matcher = make_matcher((REGEXP*) SvRV(d)); HE *he; This = SvRV(e); @@ -4263,10 +4242,30 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) RETPUSHNO; } } - else if (SM_REF(PVAV)) { - if (SM_OTHER_REF(PVAV)) { - AV *other_av = MUTABLE_AV(SvRV(Other)); - if (av_len(MUTABLE_AV(This)) != av_len(other_av)) + /* ~~ @array */ + else if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_PVAV) { + This = SvRV(e); + 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; + + for (i = 0; i < other_len; ++i) { + SV ** const svp = av_fetch(other_av, i, FALSE); + char *key; + STRLEN key_len; + + if (svp) { /* ??? When can this not happen? */ + key = SvPV(*svp, key_len); + if (hv_exists(MUTABLE_HV(SvRV(d)), key, key_len)) + RETPUSHYES; + } + } + RETPUSHNO; + } + if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVAV) { + AV *other_av = MUTABLE_AV(SvRV(d)); + if (av_len(MUTABLE_AV(SvRV(e))) != av_len(other_av)) RETPUSHNO; else { I32 i; @@ -4281,7 +4280,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) (void) sv_2mortal(MUTABLE_SV(seen_other)); } for(i = 0; i <= other_len; ++i) { - SV * const * const this_elem = av_fetch(MUTABLE_AV(This), i, FALSE); + SV * const * const this_elem = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE); SV * const * const other_elem = av_fetch(other_av, i, FALSE); if (!this_elem || !other_elem) { @@ -4301,8 +4300,8 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) (void)hv_store_ent(seen_other, sv_2mortal(newSViv(PTR2IV(*other_elem))), &PL_sv_undef, 0); - PUSHs(*this_elem); PUSHs(*other_elem); + PUSHs(*this_elem); PUTBACK; (void) do_smartmatch(seen_this, seen_other); @@ -4315,13 +4314,13 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) RETPUSHYES; } } - else if (SM_OTHER_REGEX) { - PMOP * const matcher = make_matcher(other_regex); - const I32 this_len = av_len(MUTABLE_AV(This)); + else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_REGEXP) { + PMOP * const matcher = make_matcher((REGEXP*) SvRV(d)); + const I32 this_len = av_len(MUTABLE_AV(SvRV(e))); I32 i; for(i = 0; i <= this_len; ++i) { - SV * const * const svp = av_fetch(MUTABLE_AV(This), i, FALSE); + SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE); if (svp && matcher_matches_sv(matcher, *svp)) { destroy_matcher(matcher); RETPUSHYES; @@ -4330,15 +4329,15 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) destroy_matcher(matcher); RETPUSHNO; } - else if (SvIOK(Other) || SvNOK(Other)) { + else if (SvIOK(d) || SvNOK(d)) { I32 i; - for(i = 0; i <= AvFILL(MUTABLE_AV(This)); ++i) { - SV * const * const svp = av_fetch(MUTABLE_AV(This), i, FALSE); + for(i = 0; i <= AvFILL(MUTABLE_AV(SvRV(e))); ++i) { + SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE); if (!svp) continue; - PUSHs(Other); + PUSHs(d); PUSHs(*svp); PUTBACK; if (CopHINTS_get(PL_curcop) & HINT_INTEGER) @@ -4351,16 +4350,16 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) } RETPUSHNO; } - else if (SvPOK(Other)) { - const I32 this_len = av_len(MUTABLE_AV(This)); + else if (SvPOK(d)) { + const I32 this_len = av_len(MUTABLE_AV(SvRV(e))); I32 i; for(i = 0; i <= this_len; ++i) { - SV * const * const svp = av_fetch(MUTABLE_AV(This), i, FALSE); + SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE); if (!svp) continue; - PUSHs(Other); + PUSHs(d); PUSHs(*svp); PUTBACK; (void) pp_seq(); @@ -4371,16 +4370,19 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) RETPUSHNO; } } - else if (SM_REGEX) { - PMOP * const matcher = make_matcher(this_regex); + /* ~~ qr// */ + else if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_REGEXP) { + PMOP * const matcher = make_matcher((REGEXP*) SvRV(e)); PUTBACK; - PUSHs(matcher_matches_sv(matcher, Other) + PUSHs(matcher_matches_sv(matcher, d) ? &PL_sv_yes : &PL_sv_no); destroy_matcher(matcher); RETURN; } + /* ~~ X..Y TODO */ + /* ~~ scalar */ else if ( ((SvIOK(d) || SvNOK(d)) && (This = d) && (Other = e)) || ((SvIOK(e) || SvNOK(e)) && (This = e) && (Other = d)) ) { diff --git a/t/op/smartmatch.t b/t/op/smartmatch.t index a8b387b..8123246 100644 --- a/t/op/smartmatch.t +++ b/t/op/smartmatch.t @@ -153,9 +153,9 @@ __DATA__ = $ov_obj {"key" => 1} = $ov_obj {"key" => 1, bar => 2} TODO =! $ov_obj {"foo" => 1} -= $ov_obj @keyandmore TODO += $ov_obj @keyandmore =! $ov_obj @fooormore -= $ov_obj ["key" => 1] TODO += $ov_obj ["key" => 1] =! $ov_obj ["foo" => 1] = $ov_obj /key/ TODO =! $ov_obj /foo/ @@ -232,7 +232,7 @@ __DATA__ # HASH ref against: # - another hash ref {} {} -! {} {1 => 2} +=! {} {1 => 2} {1 => 2} {1 => 2} {1 => 2} {1 => 3} ! {1 => 2} {2 => 3} @@ -245,7 +245,10 @@ __DATA__ # - an array ref [keys %main::] \%:: ! [] \%:: +! [""] {} +! [] {} [undef] {"" => 1} + [""] {"" => 1} ["foo"] { foo => 1 } ["foo", "bar"] { foo => 1 } ["foo", "bar"] \%hash @@ -256,6 +259,8 @@ __DATA__ # - a regex qr/^(fo[ox])$/ {foo => 1} ! qr/[13579]$/ +{0..99} +! qr/a*/ {} + qr/a*/ {b=>2} # - a string "foo" +{foo => 1, bar => 2} @@ -264,12 +269,14 @@ __DATA__ # - undef ! undef %hash ! undef +{"" => "empty key"} +! undef {} # ARRAY ref against: # - another array ref [] [] ! [] [1] - [["foo"], ["bar"]] [qr/o/, qr/a/] +! [["foo"], ["bar"]] [qr/o/, qr/a/] + [["foo"], ["bar"]] [qr/ARRAY/, qr/ARRAY/] ["foo", "bar"] [qr/o/, qr/a/] ! ["foo", "bar"] [qr/o/, "foo"] $deep1 $deep1 @@ -278,18 +285,20 @@ __DATA__ \...@nums \...@tied_nums # - a regex - [qw(foo bar baz quux)] qr/x/ -! [qw(foo bar baz quux)] qr/y/ + qr/x/ [qw(foo bar baz quux)] +! qr/y/ [qw(foo bar baz quux)] + /x/ [qw(foo bar baz quux)] +! /y/ [qw(foo bar baz quux)] # - a number - [qw(1foo 2bar)] 2 - [qw(foo 2)] 2 - [qw(foo 2)] 2.0_0e+0 -! [qw(1foo bar2)] 2 + 2 [qw(1foo 2bar)] + 2 [qw(foo 2)] + 2.0_0e+0 [qw(foo 2)] +! 2 [qw(1foo bar2)] # - a string -! [qw(1foo 2bar)] "2" - [qw(1foo 2bar)] "2bar" +! "2" [qw(1foo 2bar)] + "2bar" [qw(1foo 2bar)] # Number against number 2 2 @@ -305,15 +314,14 @@ __DATA__ FALSE "0" # Regex against string - qr/x/ "x" -! qr/y/ "x" + "x" qr/x/ +! "x" qr/y/ # Regex against number 12345 qr/3/ - # Test the implicit referencing - @nums 7 + 7 @nums @nums \...@nums ! @nums \...@nums @nums [1..10] -- Perl5 Master Repository
