Iterative smart match over keys/elements when a coderef is on the RHS

diff --git a/pp_ctl.c b/pp_ctl.c
index db4ba16..0b172c5 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4084,22 +4084,78 @@ 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");
 
-    if (SM_REF(PVCV)) {
+    if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_PVCV) {
        I32 c;
-       ENTER;
-       SAVETMPS;
-       PUSHMARK(SP);
-       PUSHs(Other);
-       PUTBACK;
-       c = call_sv(This, G_SCALAR);
-       SPAGAIN;
-       if (c == 0)
-           PUSHs(&PL_sv_no);
-       else if (SvTEMP(TOPs))
-           SvREFCNT_inc_void(TOPs);
-       FREETMPS;
-       LEAVE;
-       RETURN;
+       if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) {
+           /* Test sub truth for each key */
+           HE *he;
+           bool andedresults = TRUE;
+           HV *hv = (HV*) SvRV(d);
+           (void) hv_iterinit(hv);
+           while ( (he = hv_iternext(hv)) ) {
+               ENTER;
+               SAVETMPS;
+               PUSHMARK(SP);
+               PUSHs(hv_iterkeysv(he));
+               PUTBACK;
+               c = call_sv(e, G_SCALAR);
+               SPAGAIN;
+               if (c == 0)
+                   andedresults = FALSE;
+               else
+                   andedresults = SvTRUEx(POPs) && andedresults;
+               FREETMPS;
+               LEAVE;
+           }
+           if (andedresults)
+               RETPUSHYES;
+           else
+               RETPUSHNO;
+       }
+       else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVAV) {
+           /* Test sub truth for each element */
+           I32 i;
+           bool andedresults = TRUE;
+           AV *av = (AV*) SvRV(d);
+           const I32 len = av_len(av);
+           for (i = 0; i <= len; ++i) {
+               SV * const * const svp = av_fetch(av, i, FALSE);
+               ENTER;
+               SAVETMPS;
+               PUSHMARK(SP);
+               if (svp)
+                   PUSHs(*svp);
+               PUTBACK;
+               c = call_sv(e, G_SCALAR);
+               SPAGAIN;
+               if (c == 0)
+                   andedresults = FALSE;
+               else
+                   andedresults = SvTRUEx(POPs) && andedresults;
+               FREETMPS;
+               LEAVE;
+           }
+           if (andedresults)
+               RETPUSHYES;
+           else
+               RETPUSHNO;
+       }
+       else {
+           ENTER;
+           SAVETMPS;
+           PUSHMARK(SP);
+           PUSHs(d);
+           PUTBACK;
+           c = call_sv(e, G_SCALAR);
+           SPAGAIN;
+           if (c == 0)
+               PUSHs(&PL_sv_no);
+           else if (SvTEMP(TOPs))
+               SvREFCNT_inc_void(TOPs);
+           FREETMPS;
+           LEAVE;
+           RETURN;
+       }
     }
     else if (SM_REF(PVHV)) {
        if (SM_OTHER_REF(PVHV)) {

diff --git a/t/op/smartmatch.t b/t/op/smartmatch.t
index 0097bff..7736269 100644 (file)
--- a/t/op/smartmatch.t
+++ b/t/op/smartmatch.t
@@ -145,7 +145,7 @@ __DATA__
 =!     $ov_obj         \&foo
 =      $ov_obj         \&bar
 =      $ov_obj         sub { shift ~~ "key" }
-=!     $ov_obj         sub { shift eq "key" }
+=!     $ov_obj         sub { shift ne "key" }
 =!     $ov_obj         sub { shift ~~ "foo" }
 =      $ov_obj         %keyandmore                     TODO
 =!     $ov_obj         %fooormore
@@ -181,35 +181,47 @@ __DATA__
 =@     $obj    "key"
 =@     $obj    FALSE
 
-# CODE ref against argument
-#  - arg is code ref
-!      \&foo           sub {}
-
-# - arg is not code ref
-       1       sub{shift}
-!      0       sub{shift}
-!      undef   sub{shift}
-       undef   sub{not shift}
-       FALSE   sub{not shift}
-       1       sub{scalar @_}
-       []      \&bar
-       {}      \&bar
-       qr//    \&bar
-!      []      \&foo
-!      {}      \&foo
-!      qr//    \&foo
-!      undef   \&foo
-       undef   \&bar
-@      undef   \&fatal
-@      1       \&fatal
-@      []      \&fatal
-@      "foo"   \&fatal
-@      qr//    \&fatal
-# pass argument by reference
-       @fooormore      sub{scalar @_ == 1}
-       @fooormore      sub{"@_" =~ /ARRAY/}
-       %fooormore      sub{"@_" =~ /HASH/}
+# ~~ Coderef
+       sub{0}          sub { ref $_[0] eq "CODE" }
+       %fooormore      sub { $_[0] =~ /^(foo|or|more)$/ }
+!      %fooormore      sub { $_[0] =~ /^(foo|or|less)$/ }
+       \%fooormore     sub { $_[0] =~ /^(foo|or|more)$/ }
+!      \%fooormore     sub { $_[0] =~ /^(foo|or|less)$/ }
+       +{%fooormore}   sub { $_[0] =~ /^(foo|or|more)$/ }
+!      +{%fooormore}   sub { $_[0] =~ /^(foo|or|less)$/ }
+       @fooormore      sub { $_[0] =~ /^(foo|or|more)$/ }
+!      @fooormore      sub { $_[0] =~ /^(foo|or|less)$/ }
+       \@fooormore     sub { $_[0] =~ /^(foo|or|more)$/ }
+!      \@fooormore     sub { $_[0] =~ /^(foo|or|less)$/ }
+       [@fooormore]    sub { $_[0] =~ /^(foo|or|more)$/ }
+!      [@fooormore]    sub { $_[0] =~ /^(foo|or|less)$/ }
+       %fooormore      sub{@_==1}
+       @fooormore      sub{@_==1}
+       "foo"           sub { $_[0] =~ /^(foo|or|more)$/ }
+!      "more"          sub { $_[0] =~ /^(foo|or|less)$/ }
        /fooormore/     sub{ref $_[0] eq 'Regexp'}
+       qr/fooormore/   sub{ref $_[0] eq 'Regexp'}
+       1               sub{shift}
+!      0               sub{shift}
+!      undef           sub{shift}
+       undef           sub{not shift}
+       FALSE           sub{not shift}
+       [1]             \&bar
+       {a=>1}          \&bar
+       qr//            \&bar
+!      [1]             \&foo
+!      {a=>1}          \&foo
+# empty stuff matches, because the sub is never called:
+       []              \&foo
+       {}              \&foo
+!      qr//            \&foo
+!      undef           \&foo
+       undef           \&bar
+@      undef           \&fatal
+@      1               \&fatal
+@      [1]             \&fatal
+@      "foo"           \&fatal
+@      qr//            \&fatal
 
 # - null-prototyped subs
 !      undef           \&FALSE