In perl.git, the branch smartmatch has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/da9849c509b34ed24c215ecae6a458108a733936?hp=33ed63a220e7fd3d10f2504723eeeef68371efe8>

- Log -----------------------------------------------------------------
commit da9849c509b34ed24c215ecae6a458108a733936
Author: Rafael Garcia-Suarez <[email protected]>
Date:   Tue Mar 24 11:42:18 2009 +0100

    Specify that the behaviour of $foo ~~ Range should only depend on the RHS
    
    (and not from the value being checked, as Zefram remarks)

M       pod/perlsyn.pod

commit 07edf4976478e131431ffbf2f9637678422be875
Author: Rafael Garcia-Suarez <[email protected]>
Date:   Tue Mar 24 11:37:35 2009 +0100

    Make []~~\&f and {}~~\&f match
    
    (Zefram remarks that all(empty set) is true)

M       pod/perlsyn.pod
M       pp_ctl.c
M       t/op/smartmatch.t

commit ecf7aef391b44da4aba0d625608fbc4d07c5696e
Author: Rafael Garcia-Suarez <[email protected]>
Date:   Tue Mar 24 11:25:54 2009 +0100

    Fix tests for ~~ overloading
    
    I had the overload function wrong. ~~ overloading actually works.

M       t/op/smartmatch.t
-----------------------------------------------------------------------

Summary of changes:
 pod/perlsyn.pod   |   12 ++++++------
 pp_ctl.c          |    4 ++--
 t/op/smartmatch.t |   44 +++++++++++---------------------------------
 3 files changed, 19 insertions(+), 41 deletions(-)

diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod
index a51a67d..dbaa7a9 100644
--- a/pod/perlsyn.pod
+++ b/pod/perlsyn.pod
@@ -688,8 +688,8 @@ 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[1]  @$a == grep $_ ~~ $b, @$a
-    Regex   Hash      hash key grep[1]         grep /$a/, keys %$b
+    Array   Hash      hash slice existence     @$a == grep $_ ~~ $b, @$a
+    Regex   Hash      hash key grep            grep /$a/, keys %$b
     undef   Hash      always false (undef can't be a key)
     Any     Hash      hash entry existence     exists $b->{$a}
 
@@ -701,22 +701,22 @@ entries apply in those cases.
     Array   Regex     array grep               grep /$b/, @$a
     Any     Regex     pattern match            $a =~ /$b/
 
-    Num     Range[4]  in numeric range
     undef   Range[4]  always false
-    Any     Range[4]  in string range
+    Any     Range[4]  in range
 
     Any     Num       numeric equality         $a == $b
     Num     numish[5] numeric equality         $a == $b
     Any     Any       string equality          $a eq $b
 
 
- 1 - empty hashes or array won't match.
+ 1 - empty hashes or arrays will match.
  2 - that is, each element matches the element of same index in the other
      array. [3]
  3 - If a circular reference is found, we fall back to referential equality.
  4 - a range is written EXPR..EXPR (using the C<..> range operator, but
      NOT the three-dot version C<...>, which will be treated as a boolean
-     operator)
+     operator). Numeric ranges will use numeric comparison: that is,
+     "4.5 ~~ 3..5" will be true.
  5 - either a real number, or a string that looks like a number
 
 The "matching code" doesn't represent the I<real> matching code,
diff --git a/pp_ctl.c b/pp_ctl.c
index 8908850..a8a3610 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4072,7 +4072,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
            HV *hv = (HV*) SvRV(d);
            I32 numkeys = hv_iterinit(hv);
            if (numkeys == 0)
-               RETPUSHNO;
+               RETPUSHYES;
            while ( (he = hv_iternext(hv)) ) {
                ENTER;
                SAVETMPS;
@@ -4100,7 +4100,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
            AV *av = (AV*) SvRV(d);
            const I32 len = av_len(av);
            if (len == -1)
-               RETPUSHNO;
+               RETPUSHYES;
            for (i = 0; i <= len; ++i) {
                SV * const * const svp = av_fetch(av, i, FALSE);
                ENTER;
diff --git a/t/op/smartmatch.t b/t/op/smartmatch.t
index adf1c50..6993c2e 100644
--- a/t/op/smartmatch.t
+++ b/t/op/smartmatch.t
@@ -30,7 +30,7 @@ tie my %tied_hash, 'Tie::StdHash';
 {
     package Test::Object::CopyOverload;
     sub new { bless { key => 1 } }
-    use overload '~~' => sub { my %hash = %{ $_[0] }; %hash ~~ $_[1] };
+    use overload '~~' => sub { my %hash = %{ $_[0] }; $_[1] ~~ %hash };
 }
 
 our $ov_obj = Test::Object::CopyOverload->new;
@@ -79,8 +79,6 @@ while (<DATA>) {
     }
 }
 
-
-
 sub foo {}
 sub bar {42}
 sub gorch {42}
@@ -115,7 +113,7 @@ sub TRUE() { 1 }
 #   Values returned by a sub call
 __DATA__
 # Any ~~ undef
-!      $ov_obj         undef
+!=     $ov_obj         undef
 !      $obj            undef
 !      sub {}          undef
 !      %hash           undef
@@ -140,31 +138,11 @@ __DATA__
 # Any ~~ object overloaded
 # object overloaded ~~ Any
        $ov_obj         $ov_obj
-=@     $ov_obj         \&fatal
-=!     $ov_obj         \&FALSE
-=      $ov_obj         \&TRUE
-=!     $ov_obj         \&foo
-=      $ov_obj         \&bar
-=      $ov_obj         sub { shift ~~ "key" }
-=!     $ov_obj         sub { shift ne "key" }
-=!     $ov_obj         sub { shift ~~ "foo" }
-=      $ov_obj         %keyandmore                     TODO
-=!     $ov_obj         %fooormore
-=      $ov_obj         {"key" => 1}
-=      $ov_obj         {"key" => 1, bar => 2}          TODO
-=!     $ov_obj         {"foo" => 1}
-=      $ov_obj         @keyandmore
-=!     $ov_obj         @fooormore
-=      $ov_obj         ["key" => 1]
-=!     $ov_obj         ["foo" => 1]
-=      $ov_obj         /key/                           TODO
-=!     $ov_obj         /foo/
-=      $ov_obj         qr/Key/i                        TODO
-=!     $ov_obj         qr/foo/
-=      $ov_obj         "key"                           TODO
-=!     $ov_obj         "foo"
-=!     $ov_obj         FALSE
-=!     $ov_obj         TRUE
+=!     $ov_obj         \&fatal
+=      $ov_obj         {"key" => 2}
+=!     $ov_obj         {"key" => 1, bar => 2}
+=      $ov_obj         /key/
+=!     $ov_obj         /bar/
 
 # regular object
 =@     $obj    $ov_obj
@@ -214,8 +192,8 @@ __DATA__
 !      [1]             \&foo
 !      {a=>1}          \&foo
 # empty stuff matches, because the sub is never called:
-!      []              \&foo
-!      {}              \&foo
+       []              \&foo
+       {}              \&foo
 !      qr//            \&foo
 !      undef           \&foo
        undef           \&bar
@@ -226,8 +204,8 @@ __DATA__
 @      "foo"           \&fatal
 @      qr//            \&fatal
 # sub is not called on empty hashes / arrays
-!      []              \&fatal
-!      +{}             \&fatal
+       []              \&fatal
+       +{}             \&fatal
 
 # HASH ref against:
 #   - another hash ref

--
Perl5 Master Repository

Reply via email to